Comment: These are patches to produce the Andrew component of the X.V11R4 distribution, patch level 4 Andrew-Patch: 4 Date: Tue, 27 Feb 90 15:46:48 -0500 (EST) Date-span: 90/1/29 12:50:47 through 90/2/27 15:03:33 Bugs addressed: Count of patched files: 43 RCS logs: Source file: ams/libs/cui/cuilib.c Source file: ams/libs/ms/Imakefile Source file: ams/libs/ms/disambig.c Source file: ams/libs/ms/hdlnew.c Source file: ams/libs/ms/init.c Source file: ams/libs/ms/rawfil.c Source file: atk/apt/tree/treev.c Source file: atk/atkvers/atkvers.num Source file: atk/basics/x/xgraphic.c Source file: atk/basics/common/dataobj.c Source file: atk/basics/common/dataobj.ch Source file: atk/basics/common/initfls.help Source file: atk/champ/butterv.c Source file: atk/champ/chompv.c Source file: atk/champ/monthv.c Source file: atk/frame/framecmd.c Source file: atk/frame/framev.c Source file: atk/help/src/help.c Source file: atk/ness/objects/nessmark.c Source file: atk/org/orgv.c Source file: atk/rofftext/roffstyl.c Source file: atk/rofftext/roffcmds.c Source file: atk/rofftext/rofftext.c Source file: atk/rofftext/rofftxt.help Source file: atk/text/smpltext.ch Source file: atk/text/smpltext.c Source file: atk/text/text.c Source file: atk/text/txttroff.c Source file: atk/text/txtvcmds.c Source file: atk/text/tmac.atk Source file: atk/typescript/tscript.c Source file: atk/textobjects/panel.c Source file: atk/textobjects/panel.ch Source file: contrib/tm/tm.c Source file: overhead/cmenu/cmactiv.c Source file: overhead/cmenu/cmdraw.c Source file: overhead/cmenu/cmdraw.h Source file: overhead/eli/lib/prmtives.c Source file: overhead/eli/lib/Imakefile Source file: overhead/eli/lib/prims1.c Source file: overhead/eli/lib/prims2.c Source file: overhead/mail/lib/fwdvalid.c Source file: overhead/pobbconf/pobb-install.pobb Source file: overhead/pobbconf/post.office.pobb Source file: overhead/pobbconf/dj-startup.pobb *** patchlevel.h Fri Feb 2 12:23:35 1990 --- patchlevel.h.NEW Tue Feb 27 15:33:32 1990 *************** *** 1 **** ! This is the Andrew component of the X.V11R4 distribution, patch level 3 --- 1 ---- ! This is the Andrew component of the X.V11R4 distribution, patch level 4 No differences encountered *** ams/libs/cui/cuilib.c Wed Jan 17 16:35:22 1990 --- ams/libs/cui/cuilib.c.NEW Mon Feb 19 10:49:05 1990 *************** *** 3,9 **** * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ /* ! $Header: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/cui/RCS/cuilib.c,v 2.42 89/12/12 14:57:22 ghoti Exp $ $Source: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/cui/RCS/cuilib.c,v $ */ #include --- 3,9 ---- * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ /* ! $Header: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/cui/RCS/cuilib.c,v 2.43 90/02/15 15:42:34 bobg Exp $ $Source: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/cui/RCS/cuilib.c,v $ */ #include *************** *** 3221,3227 **** "Cancel resending", /* 3 -> 1 */ "Remove formatting & send", /* 2 */ "Send with formatting", /* 1 -> 3 */ ! "Trust the delivery system to remove it as needed", /* 4 -new */ NULL }; --- 3221,3227 ---- "Cancel resending", /* 3 -> 1 */ "Remove formatting & send", /* 2 */ "Send with formatting", /* 1 -> 3 */ ! NULL, NULL }; *************** *** 3257,3262 **** --- 3257,3263 ---- } else if ((external == stripct) && (external == total)) { FormatFlag = AMS_SEND_UNFORMATTED; } else { + ExtVec[4] = CUI_UseAmsDelivery ? "Trust the delivery system to remove it as needed" : NULL; ans = ChooseFromList(ExtVec, 1); switch(ans) { case 2: *** ams/libs/ms/Imakefile Wed Nov 22 11:35:34 1989 --- ams/libs/ms/Imakefile.NEW Thu Mar 8 14:20:46 1990 *************** *** 22,28 **** mungenew.o mvinvice.o namechg.o namemap.o \ newmail.o nonfatal.o openpipe.o papanote.o prsdlib.o \ parseraw.o pfmsg.o prettyn.o purge.o rawdb.o \ ! rawfile.o rebldmap.o rebldmuf.o recon.o \ redslash.o rmvdir.o renadir.o reply.o rsndhdr.o \ restilde.o fixsub.o safeexit.o setasct.o setknell.o \ setsubs.o shrkdate.o shrkname.o stack.o storfile.o strpself.o \ --- 22,28 ---- mungenew.o mvinvice.o namechg.o namemap.o \ newmail.o nonfatal.o openpipe.o papanote.o prsdlib.o \ parseraw.o pfmsg.o prettyn.o purge.o rawdb.o \ ! rawfil.o rebldmap.o rebldmuf.o recon.o \ redslash.o rmvdir.o renadir.o reply.o rsndhdr.o \ restilde.o fixsub.o safeexit.o setasct.o setknell.o \ setsubs.o shrkdate.o shrkname.o stack.o storfile.o strpself.o \ *** ams/libs/ms/disambig.c Wed Nov 22 11:32:48 1989 --- ams/libs/ms/disambig.c.NEW Mon Feb 5 11:08:25 1990 *************** *** 3,10 **** * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ /* ! $Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/ams/libs/ms/RCS/disambig.c,v 2.13 89/07/13 17:42:12 cfe Exp $ ! $Source: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/ams/libs/ms/RCS/disambig.c,v $ */ #include #include --- 3,10 ---- * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ /* ! $Header: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/ms/RCS/disambig.c,v 2.14 90/01/29 17:31:03 mcinerny Exp $ ! $Source: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/ms/RCS/disambig.c,v $ */ #include #include *************** *** 47,52 **** --- 47,54 ---- AtPtr = rindex(CopyName, '@'); if (AtPtr != NULL) { *AtPtr++ = '\0'; /* terminate the first part */ + for (tempname = AtPtr; *tempname != '\0'; ++tempname) + if (*tempname == '/') *tempname = '.'; /* restore dots in domain name */ strcpy(possiblename, "/afs/"); LCappend(possiblename, AtPtr); i = readlink(possiblename, AtName, sizeof(AtName)); *** ams/libs/ms/hdlnew.c Wed Jan 17 16:35:44 1990 --- ams/libs/ms/hdlnew.c.NEW Mon Feb 19 10:51:24 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/.andrew.cmu.edu/itc/src/andrew/ams/libs/ms/RCS/hdlnew.c,v 2.51 89/10/20 14:59:27 bobg Exp $ */ /* $ACIS: $ */ ! /* $Source: /afs/.andrew.cmu.edu/itc/src/andrew/ams/libs/ms/RCS/hdlnew.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/.andrew.cmu.edu/itc/src/andrew/ams/libs/ms/RCS/hdlnew.c,v 2.51 89/10/20 14:59:27 bobg Exp $ "; #endif /* lint */ --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/ms/RCS/hdlnew.c,v 2.52 90/02/15 15:41:15 bobg Exp $ */ /* $ACIS: $ */ ! /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/ms/RCS/hdlnew.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/ms/RCS/hdlnew.c,v 2.52 90/02/15 15:41:15 bobg Exp $ "; #endif /* lint */ *************** *** 702,707 **** --- 702,734 ---- return (0); } + /* This routine takes a file name, which is the path to a message + * in an AMS folder, and changes the protection bits on the file to + * match those on the .MS_MsgDir file in the same folder + */ + static int ReprotectBody(name) + char *name; + { + char dirName[1 + MAXPATHLEN], *ptr; + struct stat statbuf; + int bits; + + strcpy(dirName, name); + if (ptr = rindex(dirName, '/')) { + strcpy(++ptr, MS_DIRNAME); + } + else + return (1); + if (stat(dirName, &statbuf)) { + return (1); + } + bits = statbuf.st_mode; + if (chmod(name, bits)) { + return (1); + } + return (0); + } + void RealAppendMsgToDir(st, arglist, resbuf, AllowRenaming) EliState_t *st; EliCons_t *arglist; *************** *** 772,780 **** */ if (!AllowRenaming ! || (currentMessage != Msg) || (!currentMessageFile) ! || Msg->WeFiddled ! || (wasntRenamed = RenameEvenInVice(currentMessageFile, NewFileName))) { debug(4096, ("Going the long route of writing out the file anew\n")); if (WritePureFile(Msg, NewFileName, FALSE, 0644)) { CloseMSDir(Dir, MD_APPEND); --- 799,809 ---- */ if (!AllowRenaming ! || (currentMessage != Msg) || (!currentMessageFile) ! || Msg->WeFiddled ! || (wasntRenamed = RenameEvenInVice(currentMessageFile, ! NewFileName)) ! || ReprotectBody(NewFileName)) { debug(4096, ("Going the long route of writing out the file anew\n")); if (WritePureFile(Msg, NewFileName, FALSE, 0644)) { CloseMSDir(Dir, MD_APPEND); *** ams/libs/ms/init.c Wed Nov 22 11:33:23 1989 --- ams/libs/ms/init.c.NEW Mon Feb 19 10:51:51 1990 *************** *** 3,10 **** * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ /* ! $Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/ams/libs/ms/RCS/init.c,v 2.35 89/10/24 16:10:03 cfe Exp $ ! $Source: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/ams/libs/ms/RCS/init.c,v $ */ #include #include --- 3,10 ---- * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ /* ! $Header: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/ms/RCS/init.c,v 2.36 90/02/15 15:41:40 bobg Exp $ ! $Source: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/ms/RCS/init.c,v $ */ #include #include *************** *** 520,526 **** char *fullname, *userid, *domain; char **newname; { ! if (AMS_GecosHacks && ULstrcmp(domain, ThisDomain) == 0) { char *ampersand, *strt, *othr; char NameCopy[250]; int len; --- 520,527 ---- char *fullname, *userid, *domain; char **newname; { ! if (AMS_GecosHacks && domain && ThisDomain ! && (ULstrcmp(domain, ThisDomain) == 0)) { char *ampersand, *strt, *othr; char NameCopy[250]; int len; *** ams/libs/ms/rawfil.c Thu Mar 8 14:23:40 1990 --- ams/libs/ms/rawfil.c.NEW Thu Mar 8 14:20:48 1990 *************** *** 0 **** --- 1,209 ---- + /* ********************************************************************** *\ + * Copyright IBM Corporation 1988,1989 - All Rights Reserved * + * For full copyright information see:'andrew/config/COPYRITE' * + \* ********************************************************************** */ + /* + $Header: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/ms/RCS/rawfil.c,v 1.1 90/03/08 13:09:08 bobg Exp $ + $Source: /afs/andrew.cmu.edu/itc/src/andrew/ams/libs/ms/RCS/rawfil.c,v $ + */ + #include + #include + #include /* sys/file.h */ + #include + #include + #include + #ifdef WHITEPAGES_ENV + #include + #endif /* WHITEPAGES_ENV */ + #include + + #define OLDLOCK 1200 /* 20 minutes */ + + extern char *malloc(), *realloc(), *index(); + extern char MyMailDomain[]; + + ReadRawFile(File, NewMessage, DoLocking) + char *File; + struct MS_Message *NewMessage; + Boolean DoLocking; + { + struct stat statbuf; + #ifdef AFS_ENV + char *CellName[250]; + #endif /* AFS_ENV */ + char *RawBody, *uname = NULL; + struct passwd *p; + int ct, HeaderSize, fdtemp, errsave; + + debug(1, ("Entering ReadRawFile %s\n", File)); + NewMessage->OpenFD = -1; + if ((fdtemp = open(File, (DoLocking ? osi_O_READLOCK : O_RDONLY), 0)) < 0) { + AMS_RETURN_ERRCODE(errno, EIN_OPEN, EVIA_READRAWFILE); + } + if (DoLocking && osi_ExclusiveLockNoBlock(fdtemp)){ + errsave = errno; + close(fdtemp); + if (errno == EWOULDBLOCK) { + char ErrTxt[100+MAXPATHLEN]; + /* File is locked by someone else and we respect that... */ + sprintf(ErrTxt, "File in mailbox, %s, is locked", ap_Shorten(File)); + NonfatalBizarreError(ErrTxt); + } + AMS_RETURN_ERRCODE(errsave, EIN_FLOCK, EVIA_READRAWFILE); + } + if (lstat(File, &statbuf) != 0) { /* Changed from fstat to close a security hole */ + errsave = errno; + close(fdtemp); + AMS_RETURN_ERRCODE(errsave, EIN_FSTAT, EVIA_READRAWFILE); + } + NewMessage->AuthUid = 0; /* Don't trust any file owner unless it's in AFS. */ + NewMessage->AuthCell = NULL; + #ifdef AFS_ENV + if (AMS_ViceIsRunning) { + if (IsOnVice(fdtemp)) { + if (GetCellFromFileName(File, CellName, sizeof(CellName))) { + errsave = errno; + close(fdtemp); + AMS_RETURN_ERRCODE(errsave, EIN_GETCELLFROMFILE, EVIA_READRAWFILE); + } + NewMessage->AuthUid = statbuf.st_uid; + NewMessage->AuthCell = NewString(CellName); + if (!NewMessage->AuthCell) { + close(fdtemp); + AMS_RETURN_ERRCODE(ENOMEM, EIN_MALLOC, EVIA_READRAWFILE); + } + } + } + #endif /* AFS_ENV */ + debug(1, ("Set auth user to %d\n", NewMessage->AuthUid)); + if (statbuf.st_size > 0) { + if (GetHeaderSize(fdtemp, &HeaderSize)) { + close(fdtemp); + return(mserrcode); + } + if ((RawBody = malloc(HeaderSize + 1)) == NULL) { + close(fdtemp); + AMS_RETURN_ERRCODE( ENOMEM, EIN_MALLOC, EVIA_READRAWFILE); + } + ct = read(fdtemp, RawBody, HeaderSize); + if (ct != HeaderSize) { + errsave = errno; + free(RawBody); + close(fdtemp); + if (ct >= 0) { + char ErrorText[200+MAXPATHLEN]; + + sprintf(ErrorText, "Stat of file %s said it had %d bytes, but I could only read %d bytes!", ap_Shorten(File), statbuf.st_size, ct); + NonfatalBizarreError(ErrorText); + errsave = EMSBADFILESIZE; + } + AMS_RETURN_ERRCODE(errsave, EIN_READ, EVIA_READRAWFILE); + } + RawBody[HeaderSize] = 0; + NewMessage->FullSize = statbuf.st_size; + NewMessage->HeadSize = HeaderSize; + NewMessage->BodyOffsetInFD = HeaderSize; + } else { + static char *StdPrefix = "From: Message Server\nSubject: Empty file found in mailbox.\n\n"; + char *ViceOnlyString; + + #ifdef AFS_ENV + if (AMS_ViceIsRunning) { + ViceOnlyString = "To check your storage allocation on the Andrew File System,\nuse the `fs quota' command.\n\n"; + } else + #endif /* AFS_ENV */ + { + ViceOnlyString = ""; + } + if (DoLocking && (time(0) - statbuf.st_mtime) < OLDLOCK) { + close(fdtemp); + AMS_RETURN_ERRCODE( EMSYOUNGMAIL, EIN_PARAMCHECK, EVIA_READRAWFILE); + } + if ((RawBody = malloc(strlen(File) + 1500)) == NULL) { + close(fdtemp); + AMS_RETURN_ERRCODE( ENOMEM, EIN_MALLOC, EVIA_READRAWFILE); + } + if (IsOnVice(fdtemp) && NewMessage->AuthCell) { + p = getcpwuid(statbuf.st_uid, NewMessage->AuthCell); + if (p) { + GetNameFromGecos(p->pw_gecos, p->pw_name, NewMessage->AuthCell, &uname); + } + } else { + p = getpwuid(statbuf.st_uid); + if (p) { + GetNameFromGecos(p->pw_gecos, p->pw_name, MyMailDomain, &uname); + } + } + sprintf(RawBody, + "%sAn empty file was found in your mailbox. This can occur when\nan attempt to deliver mail to you is unsuccessful.\n\n", + StdPrefix); + strcat(RawBody, + "Although the delivery attempt was unsuccessful, the mail is\nnot lost. Further attempts to deliver the piece of mail will be\nmade until it is successfully delivered.\n\nNote that delivery attempts will continue to fail if delivery of the mail will put\nyou over your File System quota. The message system will not be\nable to successfully deliver your mail until you have enough space\nfor the message. "); + sprintf(RawBody + strlen(RawBody), + "%sTo reduce disk usage, you might\nwant to compress some of your files (using the compress or\ncompact commands) and/or delete old mail and unnecessary \nfiles such as 'core', checkpoint, and backup files.\n\nOther reasons for delivery failure are transient in nature,\nand will clear up without action on your part. In fact, you may already have\nreceived the mail that caused the empty file to appear.\n\n\n", + ViceOnlyString); + sprintf(RawBody + strlen(RawBody), + "File name: %s\nWritten by: user %s (%d)\nDate and time of file writing: %s\n", + File, uname ? uname : "unknown user", statbuf.st_uid, ctime(&(statbuf.st_mtime))); + NewMessage->WeFiddled = TRUE; + NewMessage->FullSize = strlen(RawBody); + if (uname) free(uname); + NewMessage->HeadSize = NewMessage->FullSize; /* only slightly bogus */ + NewMessage->BodyOffsetInFD = strlen(StdPrefix); + } + NewMessage->RawBits = RawBody; + NewMessage->RawFileDate = statbuf.st_mtime; + NewMessage->OpenFD = fdtemp; + return(0); + } + + + #define READCHUNKSIZE (1024) + + GetHeaderSize(fd, size) + int fd, *size; + { + int oldpos, result, looping = TRUE, NLAtEnd = FALSE; + char buffer[1 + READCHUNKSIZE + 1]; + char *t; + + oldpos = lseek(fd, 0, L_INCR); + *size = 0; + if (oldpos < 0) + AMS_RETURN_ERRCODE(errno, EIN_LSEEK, EVIA_GETHEADERSIZE); + if (lseek(fd, 0, L_SET) < 0) + AMS_RETURN_ERRCODE(errno, EIN_LSEEK, EVIA_GETHEADERSIZE); + while (looping) { + result = read(fd, buffer, READCHUNKSIZE); + if (result < 0) + AMS_RETURN_ERRCODE(errno, EIN_READ, EVIA_GETHEADERSIZE); + if (result) { + buffer[result] = '\0'; + if (NLAtEnd) { + t = buffer-1; + } else { + t = index(buffer, '\n'); + } + while (t) { + if (*(++t) == '\n') { + looping = FALSE; + *size += (t + 1) - buffer; + t = NULL; + } + else { + t = index(t, '\n'); + } + } + } + else /* read returned 0; end of file */ + looping = FALSE; + if (looping) { + *size += result; + NLAtEnd = (buffer[result-1] == '\n'); + } + } + if (lseek(fd, oldpos, L_SET) < 0) + AMS_RETURN_ERRCODE(errno, EIN_LSEEK, EVIA_GETHEADERSIZE); + debug(16, ("The header size for this message seems to be %d\n", *size)); + return (0); + } *** atk/apt/tree/treev.c Wed Nov 22 11:46:07 1989 --- atk/apt/tree/treev.c.NEW Mon Feb 26 14:21:37 1990 *************** *** 4,10 **** \* ********************************************************************** */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/apt/tree/RCS/treev.c,v 1.24 89/11/03 16:17:41 gk5g Exp $"; #endif /** SPECIFICATION -- External Facility Suite ********************************* --- 4,10 ---- \* ********************************************************************** */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/apt/tree/RCS/treev.c,v 1.25 90/02/20 16:17:19 gk5g Exp Locker: gk5g $"; #endif /** SPECIFICATION -- External Facility Suite ********************************* *************** *** 1757,1763 **** if ( print_stream ) treev_SetPrintStream( self, print_stream ); if ( ! GraphicsInitialized ) ! First_Time( self ); treev_PrintObject( self, file, processor, format, level, Printer ); } OUT(treev_Print); --- 1757,1763 ---- if ( print_stream ) treev_SetPrintStream( self, print_stream ); if ( ! GraphicsInitialized ) ! return; /* can't print from ezprint yet */ treev_PrintObject( self, file, processor, format, level, Printer ); } OUT(treev_Print); *** atk/atkvers/atkvers.num Wed Dec 6 17:38:40 1989 --- atk/atkvers/atkvers.num.NEW Mon Feb 19 10:57:54 1990 *************** *** 1 **** ! 14.2 --- 1 ---- ! 14.4 *** atk/basics/x/xgraphic.c Fri Feb 2 12:24:12 1990 --- atk/basics/x/xgraphic.c.NEW Mon Feb 5 11:10:17 1990 *************** *** 2,8 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/x/RCS/xgraphic.c,v 1.8 90/01/26 13:01:54 susan Exp $ */ /* $ACIS:graphic.c 1.11$ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/x/RCS/xgraphic.c,v $ */ --- 2,8 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/x/RCS/xgraphic.c,v 1.9 90/02/03 12:37:27 ajp Exp $ */ /* $ACIS:graphic.c 1.11$ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/x/RCS/xgraphic.c,v $ */ *************** *** 9,15 **** #ifndef LINT ! char xgraphic_rcsid[] = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/x/RCS/xgraphic.c,v 1.8 90/01/26 13:01:54 susan Exp $"; #endif /* LINT */ /* graphic.c --- 9,15 ---- #ifndef LINT ! char xgraphic_rcsid[] = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/x/RCS/xgraphic.c,v 1.9 90/02/03 12:37:27 ajp Exp $"; #endif /* LINT */ /* graphic.c *************** *** 1133,1144 **** struct rectangle * ClipRect; { ! VerifyUpdateClipping(self); ! XCopyArea(xgraphic_XDisplay(self), xgraphic_XWindow(self), xgraphic_XWindow(self), xgraphic_XGC(self), physical_LogicalXToGlobalX(self,rectangle_Left(SrcRect)), ! physical_LogicalYToGlobalY(self,rectangle_Top(SrcRect)), rectangle_Width(SrcRect), ! rectangle_Height(SrcRect), physical_LogicalXToGlobalX(DstGraphic,point_X(DstOrigin)), ! physical_LogicalYToGlobalY(DstGraphic,point_Y(DstOrigin))); } void xgraphic__SetBitAtLoc(self,XPos,YPos,NewValue) --- 1133,1146 ---- struct rectangle * ClipRect; { ! if (rectangle_Width(SrcRect) != 0 && rectangle_Height(SrcRect) != 0) { ! VerifyUpdateClipping(self); ! XCopyArea(xgraphic_XDisplay(self), xgraphic_XWindow(self), xgraphic_XWindow(self), xgraphic_XGC(self), physical_LogicalXToGlobalX(self,rectangle_Left(SrcRect)), ! physical_LogicalYToGlobalY(self,rectangle_Top(SrcRect)), rectangle_Width(SrcRect), ! rectangle_Height(SrcRect), physical_LogicalXToGlobalX(DstGraphic,point_X(DstOrigin)), ! physical_LogicalYToGlobalY(DstGraphic,point_Y(DstOrigin))); ! } } void xgraphic__SetBitAtLoc(self,XPos,YPos,NewValue) *** atk/basics/common/dataobj.c Wed Jan 17 16:36:54 1990 --- atk/basics/common/dataobj.c.NEW Mon Feb 26 14:23:14 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/common/RCS/dataobj.c,v 2.10 89/12/12 14:58:27 ghoti Exp $ */ /* $ACIS:dataobj.c 1.2$ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/common/RCS/dataobj.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/common/RCS/dataobj.c,v 2.10 89/12/12 14:58:27 ghoti Exp $"; #endif /* lint */ #include --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/common/RCS/dataobj.c,v 2.11 90/02/22 12:56:17 gk5g Exp $ */ /* $ACIS:dataobj.c 1.2$ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/common/RCS/dataobj.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/common/RCS/dataobj.c,v 2.11 90/02/22 12:56:17 gk5g Exp $"; #endif /* lint */ #include *************** *** 23,29 **** self->id = dataobject_UniqueID(self); self->writeID = dataobject_UNDEFINEDID; self->modified = 0; ! self->properties = namespace_New(); return TRUE; } --- 23,29 ---- self->id = dataobject_UniqueID(self); self->writeID = dataobject_UNDEFINEDID; self->modified = 0; ! self->properties = NULL; return TRUE; } *************** *** 202,207 **** --- 202,209 ---- newprop->type = type; newprop->data = value; + if (self->properties == NULL) + self->properties = namespace_New(); namespace_SetValue( self->properties, property, newprop ); } *************** *** 218,223 **** --- 220,227 ---- the specified type is NULL. If type is not NULL, but *type is, then we fill in the actual type. */ + if (self->properties == NULL) + self->properties = namespace_New(); if (namespace_Boundp(self->properties, property, &prop) && (type == NULL || *type == NULL || *type == prop->type)) { *** atk/basics/common/dataobj.ch Wed Nov 22 11:49:40 1989 --- atk/basics/common/dataobj.ch.NEW Mon Feb 26 14:23:18 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/basics/common/RCS/dataobj.ch,v 2.8 89/05/31 10:37:58 tpn Exp $ */ /* $ACIS:dataobj.ch 1.3$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/basics/common/RCS/dataobj.ch,v $ */ #if !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) ! static char *rcsiddataobject_H = "$Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/basics/common/RCS/dataobj.ch,v 2.8 89/05/31 10:37:58 tpn Exp $"; #endif /* !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) */ --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/common/RCS/dataobj.ch,v 2.8 89/05/31 10:37:58 tpn Exp $ */ /* $ACIS:dataobj.ch 1.3$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/common/RCS/dataobj.ch,v $ */ #if !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) ! static char *rcsiddataobject_H = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/basics/common/RCS/dataobj.ch,v 2.8 89/05/31 10:37:58 tpn Exp $"; #endif /* !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) */ *** atk/basics/common/initfls.help Wed Nov 22 11:51:30 1989 --- atk/basics/common/initfls.help.NEW Wed Feb 14 15:29:26 1990 *************** *** 13,22 **** \leftindent{add menu options and keybindings to procedures, or \italic{procs }, ! map file extensions to \italic{insets} or \italic{templates}, and} ! ! \leftindent{ include other initfiles}.\leftindent{ } --- 13,23 ---- \leftindent{add menu options and keybindings to procedures, or \italic{procs }, + } + \leftindent{map file extensions to \italic{insets} or \italic{templates }and + other parameter settings, and ! }\leftindent{ include other initfiles}.\leftindent{ } *************** *** 146,153 **** The syntax of an include command is: ! \bold{include \italic{filename}} Filename is the complete pathname to another initfile--do not start it with a tilde (~). It can be either a global initfile or a file belonging to you or another user. Use a separate include statement for each file you wish to --- 147,155 ---- The syntax of an include command is: ! \bold{\example{include \italic{filename + }}} Filename is the complete pathname to another initfile--do not start it with a tilde (~). It can be either a global initfile or a file belonging to you or another user. Use a separate include statement for each file you wish to *************** *** 173,189 **** The syntax of an addmenu command is: ! \bold{addmenu \italic{procedure "menustring" }[\italic{class}] [load \italic{class}] [\italic{inheritp}]} ! Example: The following line adds \bold{Dynamic Forward} searching to the bottom of the \italic{Search/Spell} menu card: ! addmenu dynsearch-search-forward "Search/Spell,Dynamic Forward~50" textview ! The addmenu command adds an extra menu item \italic{menustring} that invokes the procedure \italic{procedure}. See the help on \italic{procs} for information on how to find out what procedures are available. The\italic{ --- 175,192 ---- The syntax of an addmenu command is: ! \example{\bold{addmenu \italic{procedure "menustring" }[\italic{class}] [load \italic{class}] [\italic{inheritp}]} ! } Example: The following line adds \bold{Dynamic Forward} searching to the bottom of the \italic{Search/Spell} menu card: ! \example{addmenu dynsearch-search-forward "Search/Spell,Dynamic Forward~50" ! textview ! } The addmenu command adds an extra menu item \italic{menustring} that invokes the procedure \italic{procedure}. See the help on \italic{procs} for information on how to find out what procedures are available. The\italic{ *************** *** 190,199 **** menustring} argument has its own internal syntax: ! \bold{"[\italic{card}][\italic{~cardpriority}],\italic{item}[~\italic{itemprior\ ! ity}]"} ! You can omit any of the items show in brackets. If you do include them, do not enclose them in brackets. --- 193,202 ---- menustring} argument has its own internal syntax: ! \example{\bold{"[\italic{card}][\italic{~cardpriority}],\italic{item}[~\ ! \italic{itempriority}]"} ! } You can omit any of the items show in brackets. If you do include them, do not enclose them in brackets. *************** *** 274,289 **** The syntax for an addkey command entry is: \leftindent{ ! }\bold{addkey \italic{procedure keysequence} [\italic{class}] [load \italic{class}] [\italic{inheritp}]} ! Example. The following line binds dynamic searching to the keystroke "^S". ! addkey dynsearch-search-forward ^S textview ! (See \italic{ez-keys} for a description of what "^S" means.) --- 277,292 ---- The syntax for an addkey command entry is: \leftindent{ ! }\example{\bold{addkey \italic{procedure keysequence} [\italic{class}] [load \italic{class}] [\italic{inheritp}]} ! } Example. The following line binds dynamic searching to the keystroke "^S". ! \example{addkey dynsearch-search-forward ^S textview ! } (See \italic{ez-keys} for a description of what "^S" means.) *************** *** 310,339 **** }\leftindent{The syntax for an addfiletype command entry is: ! \bold{addfiletype .\italic{extension insetname ! }["template=\italic{templatename}"]} Example. The following line ensures that files with a .flames extension use the Lisp package for EZ called \italic{ ltext }. ! addfiletype .flames ltext ! Example. The following line ensures that that any file with a .help extension ! should be edited with the text inset and the help template. ! addfiletype .help text "template=help" ! ! The addfiletype command tells EZ to use inset type \italic{insetname} on files ! with the extension \italic{extension}. The optional \italic{template ! }specification can be used only when \italic{insetname }is \bold{text}; ! surround it with double quotes, in case there are any spaces in it. ! ! Be sure to type a period before \italic{extension}. If \italic{extension} is an asterisk (*) then \italic{insetname }will be used for files with extensions not covered by any other addfiletype command. --- 313,344 ---- }\leftindent{The syntax for an addfiletype command entry is: ! \example{\bold{addfiletype .\italic{extension insetname ! }["\italic{parameter}=\italic{value,}..."]} + } + The addfiletype command tells EZ to use inset type \italic{insetname} on files + with the extension \italic{extension}. The optional \italic{parameter} + specification lets you set parameters for that particular inset type on files + with that extension. The parameter settings permitted depend on the inset + type. The \bold{text} inset supports the parameter \bold{template}, whose + value is the name of a template. + Example. The following line ensures that files with a .flames extension use the Lisp package for EZ called \italic{ ltext }. ! \example{addfiletype .flames ltext ! } Example. The following line ensures that that any file with a .help extension ! will be edited with the text inset and the help template. ! \example{addfiletype .help text "template=help" ! } Be sure to type a period before \italic{extension}. If \italic{extension} is an asterisk (*) then \italic{insetname }will be used for files with extensions not covered by any other addfiletype command. *** atk/champ/butterv.c Wed Nov 22 11:53:00 1989 --- atk/champ/butterv.c.NEW Mon Feb 19 15:30:29 1990 *************** *** 20,42 **** struct rectangle Rect; struct butter *b = (struct butter *) butterview_GetDataObject(self); ! if (b) { ! if (!butter_GetButtonFont(b)) { ! butter_SetButtonFont(b, fontdesc_Create(b->myfontname ? b->myfontname : "andy", b->myfonttype, b->myfontsize)); } - if (!b->mycursor) { - b->mycursor = cursor_Create(self); - cursor_SetStandard(b->mycursor, Cursor_Octagon); - } - butterview_GetLogicalBounds(self, &Rect); - butterview_SetTransferMode(self, graphic_WHITE); - butterview_FillRect(self, &Rect, butterview_GetDrawable(self)); - butterview_PostCursor(self, &Rect, b->mycursor); - butterview_SetFont(self, butter_GetButtonFont(b)); - butterview_SetTransferMode(self, graphic_BLACK); - butterview_MoveTo(self, (Rect.left + Rect.width) / 2, (Rect.top + Rect.height) / 2); - butterview_DrawString(self, butter_GetText(b) ? butter_GetText(b) : "", graphic_BETWEENLEFTANDRIGHT | graphic_BETWEENTOPANDBASELINE); - } } void --- 20,43 ---- struct rectangle Rect; struct butter *b = (struct butter *) butterview_GetDataObject(self); ! if((type == view_LastPartialRedraw) || (type == view_FullRedraw)) ! if (b) { ! if (!butter_GetButtonFont(b)) { ! butter_SetButtonFont(b, fontdesc_Create(b->myfontname ? b->myfontname : "andy", b->myfonttype, b->myfontsize)); ! } ! if (!b->mycursor) { ! b->mycursor = cursor_Create(self); ! cursor_SetStandard(b->mycursor, Cursor_Octagon); ! } ! butterview_GetLogicalBounds(self, &Rect); ! butterview_SetTransferMode(self, graphic_WHITE); ! butterview_FillRect(self, &Rect, butterview_GetDrawable(self)); ! butterview_PostCursor(self, &Rect, b->mycursor); ! butterview_SetFont(self, butter_GetButtonFont(b)); ! butterview_SetTransferMode(self, graphic_BLACK); ! butterview_MoveTo(self, (Rect.left + Rect.width) / 2, (Rect.top + Rect.height) / 2); ! butterview_DrawString(self, butter_GetText(b) ? butter_GetText(b) : "", graphic_BETWEENLEFTANDRIGHT | graphic_BETWEENTOPANDBASELINE); } } void *** atk/champ/chompv.c Wed Nov 22 11:53:15 1989 --- atk/champ/chompv.c.NEW Mon Feb 19 15:30:31 1990 *************** *** 85,98 **** { struct rectangle Rect; ! chompview_GetLogicalBounds(self, &Rect); ! chompview_DrawRectSize(self, Rect.left, Rect.top, Rect.width-1, Rect.height-1); ! Rect.left += 2; ! Rect.top += 2; ! Rect.width -= 4; ! Rect.height -= 4; ! lpair_InsertView(self->toplpair, self, &Rect); ! lpair_FullUpdate(self->toplpair, type, left, top, width, height); } struct view *chompview__Hit(self, action, x, y, numberOfClicks) --- 85,100 ---- { struct rectangle Rect; ! if((type == view_LastPartialRedraw) || (type == view_FullRedraw)) { ! chompview_GetLogicalBounds(self, &Rect); ! chompview_DrawRectSize(self, Rect.left, Rect.top, Rect.width-1, Rect.height-1); ! Rect.left += 2; ! Rect.top += 2; ! Rect.width -= 4; ! Rect.height -= 4; ! lpair_InsertView(self->toplpair, self, &Rect); ! lpair_FullUpdate(self->toplpair, type, left, top, width, height); ! } } struct view *chompview__Hit(self, action, x, y, numberOfClicks) *** atk/champ/monthv.c Wed Jan 17 16:37:09 1990 --- atk/champ/monthv.c.NEW Mon Feb 19 15:30:33 1990 *************** *** 151,211 **** struct rectangle Rect; char MyString[150], *StrToUse; ! mon = (struct month *) monthview_GetDataObject(self); ! if (self->mymonth != month_GetMonth(mon) || self->myyear !=month_GetYear(mon)) { ! monthview_ResetMonth(self, (self->mymonth != -1)); ! } ! if (!plainfont) { ! plainfont = fontdesc_Create("andy", fontdesc_Plain, 12); ! } ! if (!boldfont) { ! boldfont = fontdesc_Create("andy", fontdesc_Bold, 12); ! } ! startday = -self->skippedatstart; ! monthview_SetTransferMode(self, graphic_COPY); ! monthview_GetLogicalBounds(self, &Rect); ! monthview_SetFont(self, plainfont); ! xcenter = Rect.left + (Rect.width/2); ! y = Rect.top + (Rect.height/16); ! monthview_MoveTo(self, xcenter, y); ! sprintf(MyString, "%s %d", MonthNames[self->mymonth], self->FullTimes[1].tm_year+1900); ! monthview_DrawString(self, MyString, graphic_BETWEENLEFTANDRIGHT | graphic_BETWEENTOPANDBASELINE); ! monthview_FillTrapezoid(self, Rect.left+25, Rect.top, 0, Rect.left+5, Rect.top+8, 20, monthview_BlackPattern(self)); ! monthview_FillTrapezoid(self, Rect.left+5, Rect.top+8, 20, Rect.left+25, Rect.top+16, 0, monthview_BlackPattern(self)); ! monthview_FillTrapezoid(self, Rect.left+Rect.width - 25, Rect.top, 0, Rect.left+Rect.width-25, Rect.top+8, 20, monthview_BlackPattern(self)); ! monthview_FillTrapezoid(self, Rect.left+Rect.width-25, Rect.top+8, 20, Rect.left+Rect.width-25, Rect.top+16, 0, monthview_BlackPattern(self)); ! for (i = -1; i<6; ++i) { ! y += Rect.height/8; ! x = Rect.left + (Rect.width/14); ! for (j=0; j<7; ++j, ++startday) { ! highlight = 0; ! if (i < 0) { ! StrToUse = DayAbbrevs[j]; ! --startday; ! } else if (startday <0 || startday >= MonthLength(self->myyear, self->mymonth)) { ! StrToUse = " "; ! } else { ! StrToUse = DayStrs[startday]; ! if (self->EventCt[startday] > 0) { ! highlight = 1; ! monthview_SetFont(self, boldfont); ! if (self->EventCt[startday] > 2) { ! monthview_FillRectSize(self, x-8, y-6, 18, 14, monthview_BlackPattern(self)); ! monthview_SetTransferMode(self, graphic_WHITE); ! } else if (self->EventCt[startday] > 1) { ! monthview_FillRectSize(self, x-8, y-6, 18, 14, monthview_GrayPattern(self, 3, 10)); } } } - monthview_MoveTo(self, x, y); - monthview_DrawString(self, StrToUse, graphic_BETWEENLEFTANDRIGHT | graphic_BETWEENTOPANDBASELINE); - if (highlight) { - monthview_SetTransferMode(self, graphic_COPY); - monthview_SetFont(self, plainfont); - } - x += Rect.width/7; } ! } } void monthview__Update(self) --- 151,213 ---- struct rectangle Rect; char MyString[150], *StrToUse; ! if((type == view_LastPartialRedraw) || (type == view_FullRedraw)) { ! mon = (struct month *) monthview_GetDataObject(self); ! if (self->mymonth != month_GetMonth(mon) || self->myyear !=month_GetYear(mon)) { ! monthview_ResetMonth(self, (self->mymonth != -1)); ! } ! if (!plainfont) { ! plainfont = fontdesc_Create("andy", fontdesc_Plain, 12); ! } ! if (!boldfont) { ! boldfont = fontdesc_Create("andy", fontdesc_Bold, 12); ! } ! startday = -self->skippedatstart; ! monthview_SetTransferMode(self, graphic_COPY); ! monthview_GetLogicalBounds(self, &Rect); ! monthview_SetFont(self, plainfont); ! xcenter = Rect.left + (Rect.width/2); ! y = Rect.top + (Rect.height/16); ! monthview_MoveTo(self, xcenter, y); ! sprintf(MyString, "%s %d", MonthNames[self->mymonth], self->FullTimes[1].tm_year+1900); ! monthview_DrawString(self, MyString, graphic_BETWEENLEFTANDRIGHT | graphic_BETWEENTOPANDBASELINE); ! monthview_FillTrapezoid(self, Rect.left+25, Rect.top, 0, Rect.left+5, Rect.top+8, 20, monthview_BlackPattern(self)); ! monthview_FillTrapezoid(self, Rect.left+5, Rect.top+8, 20, Rect.left+25, Rect.top+16, 0, monthview_BlackPattern(self)); ! monthview_FillTrapezoid(self, Rect.left+Rect.width - 25, Rect.top, 0, Rect.left+Rect.width-25, Rect.top+8, 20, monthview_BlackPattern(self)); ! monthview_FillTrapezoid(self, Rect.left+Rect.width-25, Rect.top+8, 20, Rect.left+Rect.width-25, Rect.top+16, 0, monthview_BlackPattern(self)); ! for (i = -1; i<6; ++i) { ! y += Rect.height/8; ! x = Rect.left + (Rect.width/14); ! for (j=0; j<7; ++j, ++startday) { ! highlight = 0; ! if (i < 0) { ! StrToUse = DayAbbrevs[j]; ! --startday; ! } else if (startday <0 || startday >= MonthLength(self->myyear, self->mymonth)) { ! StrToUse = " "; ! } else { ! StrToUse = DayStrs[startday]; ! if (self->EventCt[startday] > 0) { ! highlight = 1; ! monthview_SetFont(self, boldfont); ! if (self->EventCt[startday] > 2) { ! monthview_FillRectSize(self, x-8, y-6, 18, 14, monthview_BlackPattern(self)); ! monthview_SetTransferMode(self, graphic_WHITE); ! } else if (self->EventCt[startday] > 1) { ! monthview_FillRectSize(self, x-8, y-6, 18, 14, monthview_GrayPattern(self, 3, 10)); ! } } } + monthview_MoveTo(self, x, y); + monthview_DrawString(self, StrToUse, graphic_BETWEENLEFTANDRIGHT | graphic_BETWEENTOPANDBASELINE); + if (highlight) { + monthview_SetTransferMode(self, graphic_COPY); + monthview_SetFont(self, plainfont); + } + x += Rect.width/7; } } ! } } void monthview__Update(self) *** atk/frame/framecmd.c Wed Nov 22 12:13:25 1989 --- atk/frame/framecmd.c.NEW Thu Feb 15 09:58:52 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/frame/RCS/framecmd.c,v 2.33 89/11/13 13:07:43 ghoti Exp $ */ /* $ACIS:framecmd.c 1.3$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/frame/RCS/framecmd.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/frame/RCS/framecmd.c,v 2.33 89/11/13 13:07:43 ghoti Exp $"; #endif /* lint */ /* framecmd.c --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/.andrew.cmu.edu/itc/src/andrew/atk/frame/RCS/framecmd.c,v 2.34 90/02/14 17:29:54 gk5g Exp $ */ /* $ACIS:framecmd.c 1.3$ */ ! /* $Source: /afs/.andrew.cmu.edu/itc/src/andrew/atk/frame/RCS/framecmd.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/.andrew.cmu.edu/itc/src/andrew/atk/frame/RCS/framecmd.c,v 2.34 90/02/14 17:29:54 gk5g Exp $"; #endif /* lint */ /* framecmd.c *************** *** 1019,1030 **** if (message_AskForStringCompleted(self, 0, prompt, defaultName, bufferName, sizeof(bufferName), NULL, BufferComplete, BufferHelp, 0, - message_MustMatch | message_NoInitialString) == -1) return; targetBuffer = buffer_FindBufferByName(bufferName); if (!preventBufferLossage(self,targetBuffer)) { message_DisplayString(self, 0, "Buffer not deleted."); return; --- 1019,1034 ---- if (message_AskForStringCompleted(self, 0, prompt, defaultName, bufferName, sizeof(bufferName), NULL, BufferComplete, BufferHelp, 0, message_NoInitialString) == -1) return; targetBuffer = buffer_FindBufferByName(bufferName); + if (!targetBuffer) { + sprintf(prompt,"No buffer '%s'.",bufferName); + message_DisplayString(self, 0, prompt); + return; + } if (!preventBufferLossage(self,targetBuffer)) { message_DisplayString(self, 0, "Buffer not deleted."); return; *** atk/frame/framev.c Wed Nov 22 12:13:42 1989 --- atk/frame/framev.c.NEW Wed Feb 14 16:42:19 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/frame/RCS/framev.c,v 2.12 89/10/16 12:03:18 ajp Exp $ */ /* $ACIS:framev.c 1.4$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/frame/RCS/framev.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/frame/RCS/framev.c,v 2.12 89/10/16 12:03:18 ajp Exp $"; #endif /* lint */ #include --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/frame/RCS/framev.c,v 2.12 89/10/16 12:03:18 ajp Exp $ */ /* $ACIS:framev.c 1.4$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/frame/RCS/framev.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/frame/RCS/framev.c,v 2.12 89/10/16 12:03:18 ajp Exp $"; #endif /* lint */ #include *** atk/help/src/help.c Wed Jan 17 16:37:49 1990 --- atk/help/src/help.c.NEW Tue Feb 27 11:21:31 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/help/src/RCS/help.c,v 2.68 89/12/12 15:01:03 ghoti Exp $ */ /* $ACIS$ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/help/src/RCS/help.c,v $ */ #if !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/help/src/RCS/help.c,v 2.68 89/12/12 15:01:03 ghoti Exp $"; #endif /* !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) */ --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/help/src/RCS/help.c,v 2.70 90/02/26 16:20:12 gk5g Exp $ */ /* $ACIS$ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/help/src/RCS/help.c,v $ */ #if !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/help/src/RCS/help.c,v 2.70 90/02/26 16:20:12 gk5g Exp $"; #endif /* !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) */ *************** *** 1250,1257 **** --- 1250,1276 ---- if (self->showPanels) { scroll_UnlinkTree(self->info->scroll); + if((self->showOverview + self->showList + self->showHistory) == 0) { + self->showOverview = self->showList = self->showHistory = 1; + self->info->flags ^= (MENU_ToggleOverHide | MENU_ToggleOverShow | + MENU_ToggleListHide | MENU_ToggleListShow | + MENU_ToggleHistHide | MENU_ToggleHistShow); + lpair_SetNth(self->mainLpair, 1, SetupLpairs(self)); + } lpair_LinkTree(self->mainLpair, self); } else { + if(self->showOverview) { + self->showOverview = 0; + self->info->flags ^= (MENU_ToggleOverHide | MENU_ToggleOverShow); + } + if(self->showList) { + self->showList = 0; + self->info->flags ^= (MENU_ToggleListHide | MENU_ToggleListShow); + } + if(self->showHistory) { + self->showHistory = 0; + self->info->flags ^= (MENU_ToggleHistHide | MENU_ToggleHistShow); + } lpair_UnlinkTree(self->mainLpair); scroll_LinkTree(self->info->scroll, self); } *************** *** 1269,1296 **** long rock; { struct view *v; ! if ((self->showOverview && (rock == help_SHOW_OVER)) || (!self->showOverview && (rock == help_HIDE_OVER))) return; ! /* could fall through here if rock is ALWAYS_TOGGLE */ ! self->showOverview = 1 - self->showOverview; /* toggle */ v = SetupLpairs(self); if (v) { ! self->info->flags ^= (MENU_ToggleOverHide | MENU_ToggleOverShow); /* toggle menus */ ! if (!self->showPanels) ! TogglePanels(self, help_ALWAYS_TOGGLE); /* turn them on */ lpair_SetNth(self->mainLpair, 1, v); - self->mainLpair->needsfull = 2; /* -- hack to get redraw to work */ - super_WantInputFocus(self, self->info->view); SetupMenus(self->info); ! } else { ! self->showOverview = 1 - self->showOverview; /* toggle */ ! if (self->showPanels) ! TogglePanels(self, help_ALWAYS_TOGGLE); /* turn them off */ ! } } --- 1288,1319 ---- long rock; { struct view *v; ! boolean doUpdate = FALSE; ! if ((self->showOverview && (rock == help_SHOW_OVER)) || (!self->showOverview && (rock == help_HIDE_OVER))) return; ! /* could fall through here if rock is ALWAYS_TOGGLE */ ! self->showOverview = 1 - self->showOverview; /* toggle */ v = SetupLpairs(self); + self->info->flags ^= (MENU_ToggleOverHide | MENU_ToggleOverShow); if (v) { ! if (!self->showPanels) { ! self->showPanels = 1; ! self->info->flags ^= (MENU_TogglePanelShow | MENU_TogglePanelHide); ! scroll_UnlinkTree(self->info->scroll); ! lpair_LinkTree(self->mainLpair, self); ! doUpdate = TRUE; ! } ! self->mainLpair->needsfull = 2; /* -- hack to get redraw to work */ lpair_SetNth(self->mainLpair, 1, v); SetupMenus(self->info); ! if(doUpdate) help_Update(self); ! super_WantInputFocus(self, self->info->view); ! } else if (self->showPanels) ! TogglePanels(self, help_ALWAYS_TOGGLE); /* turn them off */ } *************** *** 1302,1329 **** long rock; { struct view *v; ! if ((self->showList && (rock == help_SHOW_LIST)) || (!self->showList && (rock == help_HIDE_LIST))) return; ! /* could fall through here if rock is ALWAYS_TOGGLE */ ! self->showList = 1 - self->showList; /* toggle */ v = SetupLpairs(self); if (v) { ! self->info->flags ^= (MENU_ToggleListHide | MENU_ToggleListShow); /* toggle menus */ ! if (!self->showPanels) ! TogglePanels(self, help_ALWAYS_TOGGLE); /* turn them on */ lpair_SetNth(self->mainLpair, 1, v); - self->mainLpair->needsfull = 2; /* -- hack to get redraw to work */ - super_WantInputFocus(self, self->info->view); SetupMenus(self->info); ! } else { ! self->showList = 1 - self->showList; /* toggle */ ! if (self->showPanels) ! TogglePanels(self, help_ALWAYS_TOGGLE); /* turn them off */ ! } } --- 1325,1356 ---- long rock; { struct view *v; ! boolean doUpdate = FALSE; ! if ((self->showList && (rock == help_SHOW_LIST)) || (!self->showList && (rock == help_HIDE_LIST))) return; ! /* could fall through here if rock is ALWAYS_TOGGLE */ ! self->showList = 1 - self->showList; /* toggle */ v = SetupLpairs(self); + self->info->flags ^= (MENU_ToggleListHide | MENU_ToggleListShow); if (v) { ! if (!self->showPanels) { ! self->showPanels = 1; ! self->info->flags ^= (MENU_TogglePanelShow | MENU_TogglePanelHide); ! scroll_UnlinkTree(self->info->scroll); ! lpair_LinkTree(self->mainLpair, self); ! doUpdate = TRUE; ! } ! self->mainLpair->needsfull = 2; /* -- hack to get redraw to work */ lpair_SetNth(self->mainLpair, 1, v); SetupMenus(self->info); ! if(doUpdate) help_Update(self); ! super_WantInputFocus(self, self->info->view); ! } else if (self->showPanels) ! TogglePanels(self, help_ALWAYS_TOGGLE); /* turn them off */ } *************** *** 1336,1365 **** long rock; { struct view *v; ! if ((self->showHistory && (rock == help_SHOW_HIST)) || (!self->showHistory && (rock == help_HIDE_HIST))) return; ! /* could fall through here if rock is ALWAYS_TOGGLE */ ! self->showHistory = 1 - self->showHistory; /* toggle */ v = SetupLpairs(self); if (v) { ! self->info->flags ^= (MENU_ToggleHistHide | MENU_ToggleHistShow); /* toggle menus */ ! if (!self->showPanels) ! TogglePanels(self, help_ALWAYS_TOGGLE); /* turn them on */ lpair_SetNth(self->mainLpair, 1, v); - self->mainLpair->needsfull = 2; /* -- hack to get redraw to work */ - super_WantInputFocus(self, self->info->view); SetupMenus(self->info); ! } else { ! self->info->flags ^= (MENU_ToggleHistHide | MENU_ToggleHistShow); /* toggle menus */ ! self->showHistory = 1 - self->showHistory; /* toggle */ ! if (self->showPanels) ! TogglePanels(self, help_ALWAYS_TOGGLE); /* turn them off */ ! SetupMenus(self->info); ! } } --- 1363,1395 ---- long rock; { struct view *v; ! boolean doUpdate = FALSE; ! if ((self->showHistory && (rock == help_SHOW_HIST)) || (!self->showHistory && (rock == help_HIDE_HIST))) return; ! /* could fall through here if rock is ALWAYS_TOGGLE */ ! self->showHistory = 1 - self->showHistory; /* toggle */ v = SetupLpairs(self); + self->info->flags ^= (MENU_ToggleHistHide | MENU_ToggleHistShow); if (v) { ! if (!self->showPanels) { ! self->showPanels = 1; ! self->info->flags ^= (MENU_TogglePanelShow | MENU_TogglePanelHide); ! scroll_UnlinkTree(self->info->scroll); ! lpair_LinkTree(self->mainLpair, self); ! doUpdate = TRUE; ! } ! self->mainLpair->needsfull = 2; /* -- hack to get redraw to work */ lpair_SetNth(self->mainLpair, 1, v); SetupMenus(self->info); ! if(doUpdate) help_Update(self); ! super_WantInputFocus(self, self->info->view); ! } ! else if (self->showPanels) ! TogglePanels(self, help_ALWAYS_TOGGLE); /* turn them off */ } *************** *** 1418,1423 **** --- 1448,1454 ---- if(panelIndex > 1) qsort(panelList, panelIndex, sizeof(char *), panelCompare); DEBUG(("removing...")); if(panelIndex > 0){ + panel_FreeAllTags(p); panel_RemoveAll(p); DEBUG(("adding...")); for (ts=panelList; *ts; ts++) { *************** *** 1487,1493 **** self->expandedList = 0; ! panel_RemoveAll(self->listPanel); /* this frees all the strings in panelList, too */ /* add only the small list of entries to listPanel */ tmp = environ_GetConfiguration(SETUP_LIBDIR); --- 1518,1525 ---- self->expandedList = 0; ! panel_FreeAllTags(self->listPanel); ! panel_RemoveAll(self->listPanel); /* this frees all the strings in panelList */ /* add only the small list of entries to listPanel */ tmp = environ_GetConfiguration(SETUP_LIBDIR); *************** *** 1576,1581 **** --- 1608,1614 ---- if (!self->showPanels) TogglePanels(self, help_ALWAYS_TOGGLE); + panel_FreeAllTags(self->tmpanel); panel_RemoveAll(self->tmpanel); scroll_SetView(self->listScroll, self->oldpanel); self->oldpanel = (struct panel *)NULL; *** atk/ness/objects/nessmark.c Wed Nov 22 12:21:43 1989 --- atk/ness/objects/nessmark.c.NEW Mon Feb 26 14:35:16 1990 *************** *** 1,12 **** /* ********************************************************************** *\ * Copyright IBM Corporation 1988,1989 - All Rights Reserved * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/ness/objects/RCS/nessmark.c,v 1.11 89/11/04 17:25:57 wjh Exp $ */ /* $ACIS:$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/ness/objects/RCS/nessmark.c,v $ */ #if !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/ness/objects/RCS/nessmark.c,v 1.11 89/11/04 17:25:57 wjh Exp $"; #endif /* nessmark.c --- 1,12 ---- /* ********************************************************************** *\ * Copyright IBM Corporation 1988,1989 - All Rights Reserved * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/ness/objects/RCS/nessmark.c,v 1.12 90/02/21 13:08:29 wjh Exp $ */ /* $ACIS:$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/ness/objects/RCS/nessmark.c,v $ */ #if !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/ness/objects/RCS/nessmark.c,v 1.12 90/02/21 13:08:29 wjh Exp $"; #endif /* nessmark.c *************** *** 18,23 **** --- 18,26 ---- */ /* $Log: nessmark.c,v $ + * Revision 1.12 90/02/21 13:08:29 wjh + * fix core leak + * * Revision 1.11 89/11/04 17:25:57 wjh * patch from Guy Harris to ness.c: * Do initializeEnvt() in ness_EstablishViews() to be sure the pointers are initialized. This avoids "!!! Disasterous error..." *************** *** 189,195 **** { struct simpletext *text = nessmark_GetText(self); nessmark_DetachFromText(self); ! if (text->markList == NULL) simpletext_Destroy(text); } --- 192,198 ---- { struct simpletext *text = nessmark_GetText(self); nessmark_DetachFromText(self); ! if (text->markList == text->fence && text->fence->next == NULL) simpletext_Destroy(text); } *************** *** 298,304 **** if (text != oldtext) { if (oldtext != NULL && ! nessmark_ObjectFree(self)) { nessmark_DetachFromText(self); ! if (oldtext->markList == NULL) simpletext_Destroy(oldtext); } nessmark_AttachToText(self, (text != NULL) ? text : nessmark_EmptyText); --- 301,308 ---- if (text != oldtext) { if (oldtext != NULL && ! nessmark_ObjectFree(self)) { nessmark_DetachFromText(self); ! if (oldtext->markList == oldtext->fence ! && oldtext->fence->next == NULL) simpletext_Destroy(oldtext); } nessmark_AttachToText(self, (text != NULL) ? text : nessmark_EmptyText); *** atk/org/orgv.c Wed Nov 22 12:24:03 1989 --- atk/org/orgv.c.NEW Mon Feb 26 14:36:03 1990 *************** *** 4,10 **** \* ********************************************************************** */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/org/RCS/orgv.c,v 1.33 89/09/07 19:43:06 tom Exp $"; #endif /** SPECIFICATION -- External Facility Suite ********************************* --- 4,10 ---- \* ********************************************************************** */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/org/RCS/orgv.c,v 1.33 89/09/07 19:43:06 tom Exp Locker: gk5g $"; #endif /** SPECIFICATION -- External Facility Suite ********************************* *** atk/rofftext/roffstyl.c Fri Feb 2 12:25:10 1990 --- atk/rofftext/roffstyl.c.NEW Wed Feb 14 16:46:46 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/rofftext/RCS/roffstyl.c,v 2.9 90/01/26 13:07:14 susan Exp $ */ /* $ACIS: $ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/rofftext/RCS/roffstyl.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/rofftext/RCS/roffstyl.c,v 2.9 90/01/26 13:07:14 susan Exp $ "; #endif /* lint */ /* styles */ --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/rofftext/RCS/roffstyl.c,v 2.10 90/02/09 13:59:54 susan Exp $ */ /* $ACIS: $ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/rofftext/RCS/roffstyl.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/rofftext/RCS/roffstyl.c,v 2.10 90/02/09 13:59:54 susan Exp $ "; #endif /* lint */ /* styles */ *************** *** 26,32 **** * where it should be passing struct *style. * This is a no-no on SPARC. */ - #define CCH WriteText(self) struct rofftext *self; --- 26,31 ---- *************** *** 64,79 **** CloseStyle(self); newid = BeginStyle(self,st); for(l=self->tempstack->level;l>=0;l--) { - union environmentcontents data; - self->stack++; self->stack->pos = self->pos; ! data.style = self->tempstack->style; ! #ifndef CCH ! self->stack->env = environment_InsertStyle((self->stack-1)->env, self->pos - (self->stack-1)->pos, data, TRUE); ! #else ! self->stack->env = environment_InsertStyle((self->stack-1)->env, self->pos - (self->stack-1)->pos, self->tempstack->style, TRUE); ! #endif self->stack->level = (self->stack-1)->level+1; self->stack->ID = self->tempstack->ID; self->tempstack--; --- 63,71 ---- CloseStyle(self); newid = BeginStyle(self,st); for(l=self->tempstack->level;l>=0;l--) { self->stack++; self->stack->pos = self->pos; ! self->stack->env = environment_InsertStyle((self->stack-1)->env, self->pos - (self->stack-1)->pos, self->tempstack->style, TRUE); self->stack->level = (self->stack-1)->level+1; self->stack->ID = self->tempstack->ID; self->tempstack--; *************** *** 113,119 **** char *st; { struct style *style; - union environmentcontents data; if (st == NULL) return 0; --- 105,110 ---- *************** *** 126,137 **** } self->stack++; self->stack->pos = self->pos; - data.style = style; - #ifndef CCH - self->stack->env = environment_InsertStyle((self->stack-1)->env, self->pos - (self->stack-1)->pos, data, TRUE); - #else self->stack->env = environment_InsertStyle((self->stack-1)->env, self->pos - (self->stack-1)->pos, style, TRUE); - #endif self->stack->level = (self->stack-1)->level+1; self->stack->ID = self->styleID++; --- 117,123 ---- *************** *** 165,176 **** } CloseStyle(self); for(l=self->tempstack->level;l>=0;l--) { - union environmentcontents data; - self->stack++; self->stack->pos = self->pos; ! data.style = self->tempstack->style; ! self->stack->env = environment_InsertStyle((self->stack-1)->env, self->pos - (self->stack-1)->pos, data, TRUE); self->stack->level = (self->stack-1)->level+1; self->stack->ID = self->tempstack->ID; self->tempstack--; --- 151,159 ---- } CloseStyle(self); for(l=self->tempstack->level;l>=0;l--) { self->stack++; self->stack->pos = self->pos; ! self->stack->env = environment_InsertStyle((self->stack-1)->env, self->pos - (self->stack-1)->pos, self->tempstack->style, TRUE); self->stack->level = (self->stack-1)->level+1; self->stack->ID = self->tempstack->ID; self->tempstack--; *** atk/rofftext/roffcmds.c Wed Nov 22 12:27:38 1989 --- atk/rofftext/roffcmds.c.NEW Wed Feb 14 16:46:54 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/rofftext/RCS/roffcmds.c,v 2.6 89/02/17 17:05:17 ghoti Exp $ */ /* $ACIS: $ */ ! /* $Source: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/rofftext/RCS/roffcmds.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/rofftext/RCS/roffcmds.c,v 2.6 89/02/17 17:05:17 ghoti Exp $ "; #endif /* lint */ /* rofftext --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/rofftext/RCS/roffcmds.c,v 2.7 90/02/09 14:38:42 susan Exp Locker: susan $ */ /* $ACIS: $ */ ! /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/rofftext/RCS/roffcmds.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/rofftext/RCS/roffcmds.c,v 2.7 90/02/09 14:38:42 susan Exp Locker: susan $ "; #endif /* lint */ /* rofftext *************** *** 133,139 **** else inc = 0; ! DEBUG((stderr,"Defining register (%s) as (%.0f)\n",argv[1],value)); putregister(self,argv[1],value,0,inc,relative); } --- 133,139 ---- else inc = 0; ! DEBUG((stderr,"Defining register (%s) as (%d)\n",argv[1],value)); putregister(self,argv[1],value,0,inc,relative); } *** atk/rofftext/rofftext.c Wed Nov 22 12:27:49 1989 --- atk/rofftext/rofftext.c.NEW Wed Feb 14 16:46:57 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/rofftext/RCS/rofftext.c,v 2.14 89/09/28 08:20:23 ghoti Exp $ */ /* $ACIS: $ */ ! /* $Source: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/rofftext/RCS/rofftext.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/rofftext/RCS/rofftext.c,v 2.14 89/09/28 08:20:23 ghoti Exp $ "; #endif /* lint */ /* rofftext --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/rofftext/RCS/rofftext.c,v 2.15 90/02/09 15:19:23 susan Exp $ */ /* $ACIS: $ */ ! /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/rofftext/RCS/rofftext.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/rofftext/RCS/rofftext.c,v 2.15 90/02/09 15:19:23 susan Exp $ "; #endif /* lint */ /* rofftext *************** *** 252,257 **** --- 252,258 ---- /* pop args */ DestroyContext(self->CurrentContext); self->CurrentContext = (IC)glist_Pop(self->ArgStack); + DEBUG((stderr, "Popping input stream\n")); } free(cur->buf); } *************** *** 934,939 **** --- 935,942 ---- tpush(self,t,NULL,NULL,self->CurrentContext->argv[atoi(temp)],FALSE,NULL,NULL); c = get(self,t); break; + case '.': /* escaped period */ + break; /* translates to just a period */ default: /* oops, it wasn't translatable */ translated = FALSE; break; *** atk/rofftext/rofftxt.help Wed Nov 22 12:27:58 1989 --- atk/rofftext/rofftxt.help.NEW Wed Feb 14 16:46:58 1990 *************** *** 27,34 **** \bold{-w} Print warning messages about badly-formed numbers. ! \bold{-m}\italic{XX} Read macro file /usr/lib/tmac/tmac.\italic{XX} before all ! input files. (\bold{-man} reads the man macro file) \bold{-o} \italic{file} Write output to \italic{file}. If this switch is not used, output will go to the standard output. --- 27,34 ---- \bold{-w} Print warning messages about badly-formed numbers. ! \bold{-m}\italic{XX} Read macro file \bold{/usr/lib/tmac/tmac.}\italic{XX} ! before all input files. (\bold{-man} reads the man macro file) \bold{-o} \italic{file} Write output to \italic{file}. If this switch is not used, output will go to the standard output. *************** *** 221,228 **** \\z\italic{c }Print \italic{c} with zero width } ! } ! \section{The roff template} \leftindent{\italic{Rofftext} uses its own style template called --- 221,227 ---- \\z\italic{c }Print \italic{c} with zero width } ! }\section{The roff template} \leftindent{\italic{Rofftext} uses its own style template called *************** *** 250,255 **** --- 249,279 ---- hanging indents.} + \section{Customizing Rofftext in your .ezinit file + + + }\leftindent{Rofftext has several parameters controlling its behavior which + you can set in your own .ezinit file. They are listed in bold with the + default setting in italic: + + + \leftindent{\bold{rofftext-macrofile} + + Specifies the full path of the macro file to use (see the \bold{-m} option) + + + \bold{rofftext-help-mode \italic{0}} + + Specifies whether files should be formatted for the help program (see the + \bold{-h} option) + + + \bold{rofftext-print-warnings \italic{0}} + + Specifies whether warning messages should be printed about badly-formed + numbers (see the \bold{-w} option)} + + } \section{Related tools} *************** *** 258,263 **** --- 282,289 ---- \indent{\italic{ez + + initfiles nroff *** atk/text/smpltext.ch Wed Nov 22 12:32:15 1989 --- atk/text/smpltext.ch.NEW Mon Feb 26 14:39:08 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/text/RCS/smpltext.ch,v 2.9 89/09/13 16:27:06 zs01 Exp Locker: tpn $ */ /* $ACIS:smpltext.ch 1.4$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/text/RCS/smpltext.ch,v $ */ #if !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) ! static char *rcsidsimpletext_H = "$Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/text/RCS/smpltext.ch,v 2.9 89/09/13 16:27:06 zs01 Exp Locker: tpn $"; #endif /* !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) */ /* Simple text conatins a string of text that can be manipulated. --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/smpltext.ch,v 2.9 89/09/13 16:27:06 zs01 Exp $ */ /* $ACIS:smpltext.ch 1.4$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/smpltext.ch,v $ */ #if !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) ! static char *rcsidsimpletext_H = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/smpltext.ch,v 2.9 89/09/13 16:27:06 zs01 Exp $"; #endif /* !defined(lint) && !defined(LOCORE) && defined(RCS_HDRS) */ /* Simple text conatins a string of text that can be manipulated. *** atk/text/smpltext.c Wed Jan 17 16:38:54 1990 --- atk/text/smpltext.c.NEW Mon Feb 26 14:39:15 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/smpltext.c,v 2.16 89/12/12 15:06:08 ghoti Exp $ */ /* $ACIS:smpltext.c 1.6$ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/smpltext.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/smpltext.c,v 2.16 89/12/12 15:06:08 ghoti Exp $"; #endif /* lint */ #include --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/smpltext.c,v 2.17 90/02/23 13:52:02 gk5g Exp $ */ /* $ACIS:smpltext.c 1.6$ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/smpltext.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/smpltext.c,v 2.17 90/02/23 13:52:02 gk5g Exp $"; #endif /* lint */ #include *************** *** 120,131 **** /* to increase the gap size to newGapSize. */ count = self->length - self->lowSize; ! t = self->string + self->length + self->gapSize - 1; ! s = self->string + totalSize - 1; ! ! while (count--) ! *s-- = *t--; ! self->gapSize = newGapSize; return TRUE; } --- 120,128 ---- /* to increase the gap size to newGapSize. */ count = self->length - self->lowSize; ! t = self->string + self->length + self->gapSize; ! s = self->string + totalSize; ! bcopy(t-count, s-count, count); self->gapSize = newGapSize; return TRUE; } *************** *** 135,141 **** long pos; { register long amount; ! register char *s, *t; if (pos > self->lowSize) { amount = pos - self->lowSize; --- 132,138 ---- long pos; { register long amount; ! char *s, *t; if (pos > self->lowSize) { amount = pos - self->lowSize; *************** *** 142,156 **** s = self->string + self->lowSize; t = self->string + self->lowSize + self->gapSize; self->lowSize += amount; ! while (amount-- > 0) ! *s++ = *t++; } else if (pos < self->lowSize) { amount = self->lowSize - pos; ! s = self->string + self->lowSize + self->gapSize - 1; ! t = self->string + self->lowSize - 1; self->lowSize -= amount; ! while (amount-- > 0) ! *s-- = *t--; } } --- 139,151 ---- s = self->string + self->lowSize; t = self->string + self->lowSize + self->gapSize; self->lowSize += amount; ! bcopy(t, s, amount); } else if (pos < self->lowSize) { amount = self->lowSize - pos; ! s = self->string + self->lowSize + self->gapSize; ! t = self->string + self->lowSize; self->lowSize -= amount; ! bcopy(t-amount, s-amount, amount); } } *************** *** 907,921 **** remlen = 0; else i = srctext->lowSize - srcpos; ! for (s = &(srctext->string[srcpos]); i > 0; s++, i--) { ! *t++ = *s; ! } srcpos = srctext->lowSize; } if (remlen > 0) { ! for (s = &(srctext->string[srcpos + srctext->gapSize]); remlen > 0; remlen--, s++) { ! *t++ = *s; ! } } self->lowSize += len; self->gapSize -= len; --- 902,915 ---- remlen = 0; else i = srctext->lowSize - srcpos; ! s = &(srctext->string[srcpos]); ! bcopy(s, t, i); ! t += i; srcpos = srctext->lowSize; } if (remlen > 0) { ! s = &(srctext->string[srcpos + srctext->gapSize]); ! bcopy(s, t, remlen); } self->lowSize += len; self->gapSize -= len; *** atk/text/text.c Wed Nov 22 12:32:32 1989 --- atk/text/text.c.NEW Mon Feb 5 11:15:24 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/text/RCS/text.c,v 2.24 89/11/02 10:21:17 tpn Exp $ */ /* $ACIS:text.c 1.7$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/text/RCS/text.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/atk/text/RCS/text.c,v 2.24 89/11/02 10:21:17 tpn Exp $"; #endif /* lint */ #include --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/text.c,v 2.24 89/11/02 10:21:17 tpn Exp Locker: tpn $ */ /* $ACIS:text.c 1.7$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/text.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/text.c,v 2.24 89/11/02 10:21:17 tpn Exp Locker: tpn $"; #endif /* lint */ #include *** atk/text/txttroff.c Wed Jan 17 16:38:57 1990 --- atk/text/txttroff.c.NEW Mon Feb 19 11:13:58 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/txttroff.c,v 2.22 90/01/11 11:20:25 tpn Exp $ */ /* $ACIS:txttroff.c 1.3$ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/txttroff.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/txttroff.c,v 2.22 90/01/11 11:20:25 tpn Exp $"; #endif /* lint */ /* --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/txttroff.c,v 2.23 90/02/16 10:37:54 tpn Exp $ */ /* $ACIS:txttroff.c 1.3$ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/txttroff.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/txttroff.c,v 2.23 90/02/16 10:37:54 tpn Exp $"; #endif /* lint */ /* *************** *** 372,385 **** sv.CurFontAttributes, sv.CurFontSize); /* Sets dFont, dFace, dSize */ ChangeFont(); /* Set default font */ if (cSize != dSize) { - #if 0 if (needNewLine) fprintf(troffFile, "\\s%d\\&", dSize); else fprintf(troffFile, ".ps %d\n", dSize); /* set point size */ - #endif - PutNewlineIfNeeded(); - fprintf(troffFile, ".ps %d\n", dSize); /* set point size */ cSize = dSize; --- 372,381 ---- *************** *** 543,549 **** fprintf(f, ".ds FF %s\n", fonttable[dFont].fontcodes[dFace]); fputs(".nr FS \\n(.s\n", f); fprintf(f, ".RS\n"); /* init real defaults */ ! } if (environ_GetProfileSwitch("hyphenate", 0)) fputs(".hy\n", f); --- 539,549 ---- fprintf(f, ".ds FF %s\n", fonttable[dFont].fontcodes[dFace]); fputs(".nr FS \\n(.s\n", f); fprintf(f, ".RS\n"); /* init real defaults */ ! if (sv.CurIndentation < 0) ! fprintf(troffFile, ".ti %dp\n", sv.CurIndentation); ! else if (sv.CurIndentation > 0) ! fprintf(troffFile, ".ti +%dp\n", sv.CurIndentation); ! } if (environ_GetProfileSwitch("hyphenate", 0)) fputs(".hy\n", f); *************** *** 943,948 **** --- 943,949 ---- int elen, cs, ln , flag,count,indexfontface,hitchars; register long i, doclen; register struct text *d,*ttxt; + register boolean quotespace; struct environment *cenv, *nenv; char *list[64],*p,*val; struct style *IndexStyle; *************** *** 1064,1069 **** --- 1065,1071 ---- /*fprintf(stderr,"::endnotes = %s\n",(endnotes == FALSE) ? "FALSE":"TRUE");fflush(stderr); */ hitchars = 0; + quotespace = TRUE; while (i < doclen) { nenv = environment_GetInnerMost(d->rootEnvironment, i); elen = environment_GetNextChange(d->rootEnvironment, i); *************** *** 1177,1182 **** --- 1179,1185 ---- if (cs) { FlushLineSpacing(cs,hitchars); cs = 0; + quotespace = TRUE; } hitchars++; /* The bar style is broken up into a separate region */ *************** *** 1260,1266 **** fprintf(f,"\\\\%3.3o",c); ln += 3; } ! else fputc(c, f); } needNewLine = 1; } --- 1263,1278 ---- fprintf(f,"\\\\%3.3o",c); ln += 3; } ! else { ! if(c == ' ') { ! if(quotespace){ ! fputc('\\',f); ! ln++; ! } ! } ! else quotespace = FALSE; ! fputc(c, f); ! } } needNewLine = 1; } *** atk/text/txtvcmds.c Wed Jan 17 16:39:05 1990 --- atk/text/txtvcmds.c.NEW Mon Feb 26 14:39:22 1990 *************** *** 3,14 **** * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/.andrew.cmu.edu/itc/src/andrew/atk/text/RCS/txtvcmds.c,v 2.37 90/01/05 11:02:23 ghoti Exp $ */ /* $ACIS:txtvcmds.c 1.7$ */ ! /* $Source: /afs/.andrew.cmu.edu/itc/src/andrew/atk/text/RCS/txtvcmds.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/.andrew.cmu.edu/itc/src/andrew/atk/text/RCS/txtvcmds.c,v 2.37 90/01/05 11:02:23 ghoti Exp $"; #endif /* lint */ #include --- 3,14 ---- * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/txtvcmds.c,v 2.38 90/02/21 11:40:11 gk5g Exp $ */ /* $ACIS:txtvcmds.c 1.7$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/txtvcmds.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/text/RCS/txtvcmds.c,v 2.38 90/02/21 11:40:11 gk5g Exp $"; #endif /* lint */ #include *************** *** 428,435 **** strcpy(messageBuf, "Search for: "); gf = message_AskForString(self, 0, messageBuf, NULL, thisString, sizeof(thisString)); if (gf < 0) return(-1); ! textview_SetDotPosition(self, ! textview_GetDotPosition(self)+textview_GetDotLength(self)); if (thisString[0] != '\000') { tp = search_CompilePattern(thisString,&lastPattern); if (tp != 0) { --- 428,435 ---- strcpy(messageBuf, "Search for: "); gf = message_AskForString(self, 0, messageBuf, NULL, thisString, sizeof(thisString)); if (gf < 0) return(-1); ! if(textview_GetDotLength(self) > 0) ! textview_SetDotPosition(self, textview_GetDotPosition(self) + 1); if (thisString[0] != '\000') { tp = search_CompilePattern(thisString,&lastPattern); if (tp != 0) { *************** *** 513,519 **** long pos = textview_GetDotPosition(self); if (forwardSearch) { ! pos = textview_GetDotPosition(self) + textview_GetDotLength(self); textview_SetDotPosition(self, pos); textview_SetDotLength(self, 0); pos = search_MatchPattern(d, pos, lastPattern); --- 513,520 ---- long pos = textview_GetDotPosition(self); if (forwardSearch) { ! if(textview_GetDotLength(self) > 0) ! pos = textview_GetDotPosition(self) + 1; textview_SetDotPosition(self, pos); textview_SetDotLength(self, 0); pos = search_MatchPattern(d, pos, lastPattern); *************** *** 923,929 **** strncpy(casedString, replacement, replacementLen); text_ReplaceCharacters(d, pos, matchLen, casedString, replacementLen); ! searchPos = pos + replacementLen; ++numReplaced; } break; --- 924,930 ---- strncpy(casedString, replacement, replacementLen); text_ReplaceCharacters(d, pos, matchLen, casedString, replacementLen); ! searchPos = pos + ((replacementLen > 0) ? 1 : 0); ++numReplaced; } break; *************** *** 939,945 **** returnPosition = FALSE; else if (reply == '='){ returnPosition = FALSE; ! searchPos = pos + matchLen; break; } } --- 940,946 ---- returnPosition = FALSE; else if (reply == '='){ returnPosition = FALSE; ! searchPos = pos + 1; break; } } *************** *** 946,956 **** /* Fall through. */ case ' ': text_ReplaceCharacters(d, pos, matchLen, replacement, replacementLen); ! searchPos = pos + replacementLen; ++numReplaced; break; case 'n': ! searchPos = pos + matchLen; break; case 'r': if (expertReplace) { --- 947,957 ---- /* Fall through. */ case ' ': text_ReplaceCharacters(d, pos, matchLen, replacement, replacementLen); ! searchPos = pos + ((replacementLen > 0) ? 1 : 0); ++numReplaced; break; case 'n': ! searchPos = pos + 1; break; case 'r': if (expertReplace) { *** atk/text/tmac.atk Wed Nov 22 12:33:09 1989 --- atk/text/tmac.atk.NEW Wed Feb 7 11:41:39 1990 *************** *** 70,82 **** .ig Running headers & footers. These will be called from the header & footer macro ! halfway the current margins in the macros PT & BT Note that we don't use the page counter (%) directly. We stick the value in register PN. This allows for changing the format of the page number with the .af request without screwing up troff - - We will enable the possibility to change on odd & even pages eventually .. .\" . \" PT - Page Trap & Bottom Trap macro --- 70,81 ---- .ig Running headers & footers. These will be called from the header & footer macro ! halfway the current margins in the macros PT & BT by the macros ! pT and bT respectively. Note that we don't use the page counter (%) directly. We stick the value in register PN. This allows for changing the format of the page number with the .af request without screwing up troff .. .\" . \" PT - Page Trap & Bottom Trap macro *************** *** 87,98 **** .ie \\n(Tc=3 .nr PN \\n%-\\n(Pc .el .nr PN \\n% .nr Pn \\n% ! .if \\n(Pn>1 .if e .tl '\\*(LT'\\*(CT'\\*(RT' ! .if \\n(Pn>1 .if o .tl '\\*(RT'\\*(CT'\\*(LT' .po .. . \" default footer string definitions .po +\\n(INu .de BT .nr PF \\n(.f .nr PX \\n(.s --- 86,97 ---- .ie \\n(Tc=3 .nr PN \\n%-\\n(Pc .el .nr PN \\n% .nr Pn \\n% ! .pT .po .. . \" default footer string definitions .po +\\n(INu + . \" BT -- Bottom trap handling .de BT .nr PF \\n(.f .nr PX \\n(.s *************** *** 100,107 **** .ps \\n(PS .lt \\n(LTu .po +\\n(INu ! .if e .tl '\\*(LB'\\*(CB'\\*(RB' ! .if o .tl '\\*(RB'\\*(CB'\\*(LB' .ft \\n(PF .ps \\n(PX .po --- 99,105 ---- .ps \\n(PS .lt \\n(LTu .po +\\n(INu ! .bT .ft \\n(PF .ps \\n(PX .po *************** *** 112,118 **** . TC .\} .. ! . \" default header string definitions .ds CT - \\n(PN - .\" .\" --- 110,157 ---- . TC .\} .. ! . \" DP Duplex -- versus Simplex printing ! . \" if register DP != 0, Simplex printing ! . \" ! . \" Si -- silly macro, if called as .Simplex ! . \" it will turn to simplex mode ! . \" Ever seen this technique before? ! .de Si ! .if '\\$1'mplex' .nr DP 1 ! .. ! . \" OH -- the recto (odd page) header or default header ! .de OH ! .tl '\\*(LT'\\*(CT'\\*(RT' ! .. ! . \" EH -- the verso (even) page header, only in duplex mode ! .de EH ! .tl '\\*(RT'\\*(CT'\\*(LT' ! .. ! . \" pT -- really do header ! .de pT ! .ie \\n(DP=0 \{\ ! . if o .if \\n(Pn>1 .OH ! . if e .if \\n(Pn>1 .EH ! .\} ! .el .if \\n(Pn>1 .OH ! .. ! . \" bT -- really do footer ! .de bT ! .ie \\n(DP=0 \{\ ! . if o .OB ! . if e .EB ! .\} ! .el .OB ! .. ! . \" OB -- the recto (odd) footer or default footer ! .de OB ! .tl '\\*(LB'\\*(CB'\\*(RB' ! .. ! . \" EB -- the verso (even) footer, only in duplex mode ! .de EB ! .tl '\\*(RB'\\*(CB'\\*(LB' ! .. ! . \" no default header string definitions .ds CT - \\n(PN - .\" .\" *************** *** 133,140 **** .ft \\n(PF 'sp |\\n(HMu .nr Fc 0 1 \" init footnote count ! .nr Fp 0-\\n(HMu \" current footer place ! .ch FO -\\n(HMu \" reset footer trap .if \\n(dn .Fz \" proces left over footnote .ns \" no space mode .. --- 172,179 ---- .ft \\n(PF 'sp |\\n(HMu .nr Fc 0 1 \" init footnote count ! .nr Fp 0-\\n(FMu \" current footer place ! .ch FO -\\n(FMu \" reset footer trap .if \\n(dn .Fz \" proces left over footnote .ns \" no space mode .. *************** *** 223,230 **** .\" We aks for a couple of lines with the .ne statement, will trigger the .\" bottom of page trap on the moment when there is no space .de HE ! .ne 1.5i .. .\" .\" IC - in table of contents .\" $1 type of header $3 number, $2 text --- 262,274 ---- .\" We aks for a couple of lines with the .ne statement, will trigger the .\" bottom of page trap on the moment when there is no space .de HE ! .br ! .ne 3.1v .. + .de OC + .br + .ne 3.1v + .. .\" .\" IC - in table of contents .\" $1 type of header $3 number, $2 text *************** *** 288,298 **** .\" .\" set end macro .em EM - .\" in texttroff .IZ - .\" in texttroff .RS .\" .\" .\" .\" Begin of the PSmacros, coutesy of fred hansen (I believe) .\" .nr zT 0 --- 332,352 ---- .\" .\" set end macro .em EM .\" + .\" ix - index creation macros. Basic idea bwk .\" + .\" basic idea: if not in a diversion, + .\" put the arguments on stndard error + .\" else + .\" call ix again (which will actually happen when + .\" the diverted string is read back) + .\" elif + .de ix + .ie '\\n(.z'' .tm ix: \\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 \\n% + .el \\!.ix \\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 + .. .\" + .\" .\" Begin of the PSmacros, coutesy of fred hansen (I believe) .\" .nr zT 0 *************** *** 345,358 **** .. .\" .\" End of PSmacros - .\" - .\" - .\" ix macro for index production. - .\" - .de ix - .ie '\\n(.z'' .tm ix: \\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 \\n% - .el \\!.ix \\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9 \\n% - .. - .\" - .\" End of ix macro .\" --- 399,402 ---- *** atk/typescript/tscript.c Wed Jan 17 16:39:13 1990 --- atk/typescript/tscript.c.NEW Mon Feb 26 14:40:04 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/typescript/RCS/tscript.c,v 2.28 89/11/21 15:26:55 jhh Exp $ */ /* $ACIS:tscript.c 1.5$ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/typescript/RCS/tscript.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/typescript/RCS/tscript.c,v 2.28 89/11/21 15:26:55 jhh Exp $"; #endif /* lint */ --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/typescript/RCS/tscript.c,v 2.28 89/11/21 15:26:55 jhh Exp Locker: tpn $ */ /* $ACIS:tscript.c 1.5$ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/atk/typescript/RCS/tscript.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/atk/typescript/RCS/tscript.c,v 2.28 89/11/21 15:26:55 jhh Exp Locker: tpn $"; #endif /* lint */ *** atk/textobjects/panel.c Wed Nov 22 12:36:20 1989 --- atk/textobjects/panel.c.NEW Mon Feb 26 14:40:22 1990 *************** *** 16,21 **** --- 16,22 ---- #include #include #include + #include #include #include *************** *** 36,42 **** while (pe != NULL) { register struct panel_Entry *ne; ne = pe->next; - free(pe->tag); free(pe); pe = ne; } --- 37,42 ---- *************** *** 102,109 **** panel_SetDotPosition(self, pe->pos); panel_FrameDot(self, pe->pos); panel_SetDotLength(self, 0); - panel_WantUpdate(self, self); panel_LoseInputFocus(self); (*self->handler)(self->globalTag, pe->tag, self); } --- 102,109 ---- panel_SetDotPosition(self, pe->pos); panel_FrameDot(self, pe->pos); panel_SetDotLength(self, 0); panel_LoseInputFocus(self); + im_ForceUpdate(); (*self->handler)(self->globalTag, pe->tag, self); } *************** *** 296,302 **** if (pe->pos >= entry->pos) pe->pos -= len; - free(entry->tag); free(entry); } --- 296,301 ---- *************** *** 436,438 **** --- 435,450 ---- panel_LoseInputFocus(self); return (struct view *)NULL; } + + void panel__FreeAllTags(self) + struct panel *self; + { + register struct panel_Entry *e; + register char *tag; + + if((e = panel_EntryRoot(self)) != NULL) + for(;e != NULL;e = panel_EntryNext(self,e)) + if((tag = panel_EntryTag(self,e)) != NULL) + free(tag); + } + *** atk/textobjects/panel.ch Wed Nov 22 12:36:24 1989 --- atk/textobjects/panel.ch.NEW Mon Feb 26 14:40:26 1990 *************** *** 44,49 **** --- 44,50 ---- Add(char *item, char *tag, int showNow) returns struct panel_Entry *; Remove(struct panel_Entry *entry); RemoveAll(); + FreeAllTags(); /* destroys the client tag(rock) associated w/ a panel_Entry */ /* MakeSelection highlights but does not call handler. */ /* User clicking on item highlights and calls handler. */ *************** *** 84,89 **** --- 85,96 ---- /* Useful inheritance: SetDefaultStyle(pv, style) */ /* Useful inheritance: SetBorder(pv, hpix, vpix); */ + + /* panel_Entry access macros */ + + EntryRoot() ((self)->panelList) + EntryNext(pe) ((pe)->next) + EntryTag(pe) ((pe)->tag) overrides: Hit(enum view_MouseAction action, long x, long y, long numberOfClicks) returns struct view *; *** contrib/tm/tm.c Wed Nov 22 12:47:51 1989 --- contrib/tm/tm.c.NEW Wed Feb 28 12:21:52 1990 *************** *** 2,13 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/contrib/tm/RCS/tm.c,v 2.16 89/11/06 10:15:53 ghoti Exp $ */ /* $ACIS:tm.c 1.4$ */ ! /* $Source: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/contrib/tm/RCS/tm.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/contrib/tm/RCS/tm.c,v 2.16 89/11/06 10:15:53 ghoti Exp $"; #endif /* lint */ #include --- 2,13 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/.andrew.cmu.edu/itc/src/andrew/contrib/tm/RCS/tm.c,v 2.17 90/02/28 11:59:59 tpn Exp $ */ /* $ACIS:tm.c 1.4$ */ ! /* $Source: /afs/.andrew.cmu.edu/itc/src/andrew/contrib/tm/RCS/tm.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/.andrew.cmu.edu/itc/src/andrew/contrib/tm/RCS/tm.c,v 2.17 90/02/28 11:59:59 tpn Exp $"; #endif /* lint */ #include *************** *** 1357,1364 **** if(fscanf(fp,"\\enddata{%[^,],%d}\n",dummyS,&dummyI)!=2) return dataobject_MISSINGENDDATAMARKER; ! if(termulator_StartProcess(self,args)!=0) ! return dataobject_OBJECTCREATIONFAILED; return dataobject_NOREADERROR; } --- 1357,1364 ---- if(fscanf(fp,"\\enddata{%[^,],%d}\n",dummyS,&dummyI)!=2) return dataobject_MISSINGENDDATAMARKER; ! /* A statement here to start up termulator with the read args ! has been removed , as it represented a major security hole. tpn 2/28/90 */ return dataobject_NOREADERROR; } *** overhead/cmenu/cmactiv.c Wed Nov 22 13:35:47 1989 --- overhead/cmenu/cmactiv.c.NEW Mon Feb 26 14:55:07 1990 *************** *** 2,12 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/.andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/overhead/cmenu/RCS/cmactiv.c,v 2.4 89/02/10 23:08:51 ghoti Exp $ */ ! /* $Source: /afs/.andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/overhead/cmenu/RCS/cmactiv.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/.andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/overhead/cmenu/RCS/cmactiv.c,v 2.4 89/02/10 23:08:51 ghoti Exp $"; #endif /* lint */ #include --- 2,12 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/overhead/cmenu/RCS/cmactiv.c,v 2.7 90/02/22 16:11:13 gk5g Exp $ */ ! /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/overhead/cmenu/RCS/cmactiv.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/overhead/cmenu/RCS/cmactiv.c,v 2.7 90/02/22 16:11:13 gk5g Exp $"; #endif /* lint */ #include *************** *** 50,55 **** --- 50,56 ---- } } + #ifdef ATTEMPTSAVEUNDERS /* This function defines all events which should be cleared from the queue * when we are done. */ *************** *** 75,80 **** --- 76,82 ---- return FALSE; } } + #endif /* ATTEMPTSAVEUNDERS */ static int HandlePress(menu, buttonEvent, state) struct cmenu *menu; *************** *** 239,245 **** Display *display = menu->gMenuData->dpy; XEvent event; /* X input event. */ - XExposeEvent *exposeEvent = (XExposeEvent *) &event; /* Actually used for getting fields of event. */ struct activationState state; /* Packaged state for passing to subroutines. */ /* --- 241,246 ---- *************** *** 258,263 **** --- 259,265 ---- return(cm_FAILURE); } + #ifdef ATTEMPTSAVEUNDERS /* Decide if we need/want to save the image under the menus. */ state.drawingState.doSaveUnder = (backgroundType != cmenu_NoSaveUnder) && !DoesSaveUnders(DefaultScreenOfDisplay(display)); *************** *** 264,269 **** --- 266,272 ---- /* If saving the image, grab the server so the image cannot be modified while we are up. */ if (state.drawingState.doSaveUnder) XGrabServer(display); + #endif /* ATTEMPTSAVEUNDERS */ state.startTime = menuEvent->time; state.up = TRUE; *************** *** 296,305 **** --- 299,310 ---- ret_val = cm_NO_SELECT; } + #ifdef ATTEMPTSAVEUNDERS /* Prevent server from covering area with background when menus go down. */ if (state.drawingState.doSaveUnder) XSetWindowBackgroundPixmap(display, state.parentWindow, None); + #endif /* ATTEMPTSAVEUNDERS */ XUnmapWindow(display, menu->gMenuData->menuWindow); *************** *** 319,332 **** */ XSync(display, 0); /* * Dispatch any events remaining on the queue for menu or bounding box windows. */ if (state.drawingState.doSaveUnder) { ! do { ! XIfEvent(display, &event, DiscardableEvents, (char *) &state); ! } while (exposeEvent->type != Expose || exposeEvent->window != state.parentWindow || exposeEvent->count != 0); XCopyArea(display, state.drawingState.saveUnder, state.parentWindow, menu->gMenuData->saveUnderGC, 0, 0, state.drawingState.saveUnderWidth, state.drawingState.saveUnderHeight, state.drawingState.saveUnderX, state.drawingState.saveUnderY); --- 324,336 ---- */ XSync(display, 0); + #ifdef ATTEMPTSAVEUNDERS /* * Dispatch any events remaining on the queue for menu or bounding box windows. */ if (state.drawingState.doSaveUnder) { ! while(XCheckIfEvent(display, &event, DiscardableEvents, (char *) &state)); XCopyArea(display, state.drawingState.saveUnder, state.parentWindow, menu->gMenuData->saveUnderGC, 0, 0, state.drawingState.saveUnderWidth, state.drawingState.saveUnderHeight, state.drawingState.saveUnderX, state.drawingState.saveUnderY); *************** *** 340,345 **** --- 344,350 ---- XUngrabServer(display); } + #endif /* ATTEMPTSAVEUNDERS */ /* Make sure everything is out to the server. */ XFlush(display); *** overhead/cmenu/cmdraw.c Wed Jan 17 16:39:53 1990 --- overhead/cmenu/cmdraw.c.NEW Mon Feb 26 14:55:14 1990 *************** *** 2,12 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/overhead/cmenu/RCS/cmdraw.c,v 2.5 90/01/11 11:03:30 tpn Exp $ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/overhead/cmenu/RCS/cmdraw.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/overhead/cmenu/RCS/cmdraw.c,v 2.5 90/01/11 11:03:30 tpn Exp $"; #endif /* lint */ #include --- 2,12 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/overhead/cmenu/RCS/cmdraw.c,v 2.6 90/02/22 16:13:01 gk5g Exp $ */ /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/overhead/cmenu/RCS/cmdraw.c,v $ */ #ifndef lint ! static char *rcsid = "$Header: /afs/andrew.cmu.edu/itc/src/andrew/overhead/cmenu/RCS/cmdraw.c,v 2.6 90/02/22 16:13:01 gk5g Exp $"; #endif /* lint */ #include *************** *** 445,450 **** --- 445,454 ---- XMoveResizeWindow(display, globalData->menuWindow, state->stackLeft, state->stackTop, state->stackWidth, state->stackHeight); + #ifdef ATTEMPTSAVEUNDERS + + /* This code has been ifdef'ed out because of a problem that occurs when the parentWindow of the menuWindow is somehow not around to receive expose events after the menuWindow is unmapped from a screen whose owning X server does not have save-under enabled. The result is that the server hangs, waiting for that expose event in the routine cmenu_Active (cmactiv.c). */ + if (state->doSaveUnder) { /* Hair city... */ Window dummyWindow; *************** *** 491,496 **** --- 495,501 ---- if ((state->saveUnder = XCreatePixmap(display, parentWindow, state->saveUnderWidth, state->saveUnderHeight, depth)) != 0) XCopyArea(display, parentWindow, state->saveUnder, globalData->saveUnderGC, state->saveUnderX, state->saveUnderY, state->saveUnderWidth, state->saveUnderHeight, 0, 0); } + #endif /* ATTEMPTSAVEUNDERS */ if (menu->numberOfPanes > 0) { /* Position Cursor at left of topmost menu */ *** overhead/cmenu/cmdraw.h Wed Nov 22 13:35:52 1989 --- overhead/cmenu/cmdraw.h.NEW Mon Feb 26 14:55:20 1990 *************** *** 2,9 **** * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/.andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/overhead/cmenu/RCS/cmdraw.h,v 2.4 89/02/13 09:21:49 ghoti Exp $ */ ! /* $Source: /afs/.andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/overhead/cmenu/RCS/cmdraw.h,v $ */ struct drawingState { int stackLeft; --- 2,9 ---- * Copyright IBM Corporation 1988,1989 - All Rights Reserved * * For full copyright information see:'andrew/config/COPYRITE' * \* ********************************************************************** */ ! /* $Header: /afs/andrew.cmu.edu/itc/src/andrew/overhead/cmenu/RCS/cmdraw.h,v 2.6 90/02/22 16:14:23 gk5g Exp $ */ ! /* $Source: /afs/andrew.cmu.edu/itc/src/andrew/overhead/cmenu/RCS/cmdraw.h,v $ */ struct drawingState { int stackLeft; *************** *** 22,27 **** --- 22,28 ---- struct pane *panePtr; /* Pointer to current pane. */ int selectionNum; /* Index of current selection. */ struct selection *selectionPtr;/* Pointer to current Selection. */ + #ifdef ATTEMPTSAVEUNDERS int doSaveUnder; /* Boolean indicating whether or not to do save under. */ Pixmap saveUnder; /* Actual saved bits. */ int saveUnderX; /* rectangle of saveunder in parent window. */ *************** *** 28,33 **** --- 29,35 ---- int saveUnderY; int saveUnderWidth; int saveUnderHeight; + #endif /* ATTEMPTSAVEUNDERS */ }; #define cmenu_Behind 1 /* Draw a card behind another card. */ *** overhead/eli/lib/prmtives.c Wed Nov 22 13:38:05 1989 --- overhead/eli/lib/prmtives.c.NEW Wed Feb 14 16:53:47 1990 *************** *** 4,12 **** \* ********************************************************************** */ /* ! * $Header: /afs/.andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/overhead/eli/lib/RCS/prmtives.c,v 2.25 89/10/03 16:53:53 cfe Exp $ * ! * $Source: /afs/.andrew.cmu.edu/itc/sm/releases/X.V11R4/andrew/overhead/eli/lib/RCS/prmtives.c,v $ */ #include --- 4,12 ---- \* ********************************************************************** */ /* ! * $Header: /afs/andrew.cmu.edu/itc/src/andrew/overhead/eli/lib/RCS/prmtives.c,v 2.25 89/10/03 16:53:53 cfe Exp $ * ! * $Source: /afs/andrew.cmu.edu/itc/src/andrew/overhead/eli/lib/RCS/prmtives.c,v $ */ #include *** overhead/eli/lib/Imakefile Wed Nov 22 13:38:15 1989 --- overhead/eli/lib/Imakefile.NEW Wed Feb 14 16:53:51 1990 *************** *** 10,16 **** ecommon.o eerror.o elil.o \ eliy.o errnode.o errops.o \ errstk.o errstkop.o eval.o ht.o \ ! intrface.o prmtives.o stack.o \ stk.o str.o strtab.o sym.o \ symtab.o --- 10,16 ---- ecommon.o eerror.o elil.o \ eliy.o errnode.o errops.o \ errstk.o errstkop.o eval.o ht.o \ ! intrface.o prims1.o prims2.o stack.o \ stk.o str.o strtab.o sym.o \ symtab.o *** overhead/eli/lib/prims1.c Tue Feb 27 15:44:34 1990 --- overhead/eli/lib/prims1.c.NEW Wed Feb 14 16:53:57 1990 *************** *** 0 **** --- 1,2468 ---- + /* ********************************************************************** *\ + * Copyright IBM Corporation 1988,1989 - All Rights Reserved * + * For full copyright information see:'andrew/config/COPYRITE' * + \* ********************************************************************** */ + + /* + * $Header: /afs/andrew.cmu.edu/itc/src/andrew/overhead/eli/lib/RCS/prims1.c,v 1.1 90/02/13 15:23:17 bobg Exp $ + * + * $Source: /afs/andrew.cmu.edu/itc/src/andrew/overhead/eli/lib/RCS/prims1.c,v $ + */ + + #include + #include + + static struct { + char *name; + void (*fn) (); + } primList[] = {{ + + "TRACE", Prim_TRACE + }, + { + "PLUS", Prim_PLUS + }, + { + "+", Prim_PLUS + }, + { + "SETQ", Prim_SETQ + }, + { + "DEFUN", Prim_DEFUN + }, + { + "DEFUNQ", Prim_DEFUNQ + }, + { + "CONS", Prim_CONS + }, + { + "PROGN", Prim_PROGN + }, + { + "EVAL", Prim_EVAL + }, + { + "CAR", Prim_CAR + }, + { + "CDR", Prim_CDR + }, + { + "LIST", Prim_LIST + }, + { + "COND", Prim_COND + }, + { + "PRINT", Prim_PRINT + }, + { + "TERPRI", Prim_TERPRI + }, + { + "EQ", Prim_EQ + }, + { + "STRCONTAINS", Prim_STRCONTAINS + }, + { + "ASSOC", Prim_ASSOC + }, + { + "STRSTARTS", Prim_STRSTARTS + }, + { + "LET*", Prim_LETSTAR + }, + { + "AND", Prim_AND + }, + { + "OR", Prim_OR + }, + { + "NOT", Prim_NOT + }, + { + "NULL", Prim_NOT + }, + { + "DO*", Prim_DOSTAR + }, + { + "READ", Prim_READ + }, + { + "CONSP", Prim_CONSP + }, + { + "STRINGP", Prim_STRINGP + }, + { + "ATOM", Prim_ATOM + }, + { + "NUMBERP", Prim_NUMBERP + }, + { + "LESSP", Prim_LESSP + }, + { + "BOUNDP", Prim_BOUNDP + }, + { + "MINUS", Prim_MINUS + }, + { + "-", Prim_MINUS + }, + { + "TIMES", Prim_TIMES + }, + { + "*", Prim_TIMES + }, + { + "DIV", Prim_DIV + }, + { + "STRCAT", Prim_STRCAT + }, + { + "INDEX", Prim_INDEX + }, + { + "RINDEX", Prim_RINDEX + }, + { + "STRDECOMPOSE", Prim_STRDECOMPOSE + }, + { + "STRLEN", Prim_STRLEN + }, + { + "LCSTRING", Prim_LCSTRING + }, + { + "APPEND", Prim_APPEND + }, + { + "RE-STRCONTAINS", Prim_RE_STRCONTAINS + }, + { + "SUBSTRING", Prim_SUBSTRING + }, + { + "SYMBOLP", Prim_SYMBOLP + }, + { + "PLUMBER", Prim_PLUMBER + }, + { + "RE-STRDECOMPOSE", Prim_RE_STRDECOMPOSE + }, + { + "GENSYM", Prim_GENSYM + }, + { + "FUNCTION", Prim_FUNCTION + }, + { + "LOAD", Prim_LOAD + }, + { + "RE-STRDECOMPOSE+", Prim_RE_STRDECOMPOSEPLUS + }, + { + "LET", Prim_LET + }, + { + "DO", Prim_DO + }, + { + "SYM-TO-STR", Prim_SYM_TO_STR + }, + { + "STR-TO-INT", Prim_STR_TO_INT + }, + { + "INT-TO-STR", Prim_INT_TO_STR + }, + { + "PRINTF", Prim_PRINTF + }, + { + "PUTS", Prim_PUTS + }, + { + "SYSTEM", Prim_SYSTEM + }, + { + "GETENV", Prim_GETENV + }, + { + "DEBUG", Prim_DEBUG + }, + { + "EQUAL", Prim_EQUAL + }, + { + "UCSTRING", Prim_UCSTRING + }, + { + "UNBINDFN", Prim_UNBINDFN + }, + { + "UNBIND", Prim_UNBIND + }, + { + "DISCARD", Prim_DISCARD + }, + { + "ERROR", Prim_ERROR + }, + { + "DEFUNV", Prim_DEFUNV + }, + { + "DEFUNVQ", Prim_DEFUNVQ + }, + { + "VERSION", Prim_VERSION + }, + { + "FILTER", Prim_FILTER + }, + { + NULL, NULL + } + }; /* Must end this way */ + + static jmp_buf brokenPipeEnv, alarmEnv; + + void eliPrimInit(st) + EliState_t *st; + { + int i; + + for (i = 0; primList[i].name; ++i) { + eliPrimDefCompiled(st, primList[i].name, primList[i].fn); + if (EliErr_ErrP(st)) + return; + } + } + + void eliPrimDefCompiled(st, name, fn) + EliState_t *st; + char *name; + void (*fn) (); + + { + EliFn_t *tmp; + + if (!(tmp = eliFn_GetNew_trace(st, EliTraceStk(st)))) + return; + eliFn_SetCompiled(st, tmp, fn); + EliPrimDef(st, name, tmp); + if (EliErr_ErrP(st)) + return; /* Another nutso place to put this */ + } + + + /* Define a function: bind it to a symbol & place in global table */ + + void EliPrimDef(st, name, fn) + EliState_t *st; + char *name; + EliFn_t *fn; + { + EliSym_t *symtmp; + + symtmp = eliSymTab_FindOrMake(st, EliSymbolTable(st), name); + if (EliErr_ErrP(st)) + return; + EliSym_BindFn(st, symtmp, fn); + } + + /* If the string s1 is found in s2, return that part of s2 that + * begins with s1, else NULL + */ + char *eliFindPrefix(s1, s2, ignoreCase) + char *s1, *s2; + int ignoreCase; + { + int len = strlen(s1), looping = TRUE; + char *place = NULL, *ptr2, *pat, *ref, *orig = s2, *ref2; + + if (!(pat = EliSaveString(s1))) + return (NULL); + if (!(ref = EliSaveString(s2))) { + free(pat); + return (NULL); + } + if (ignoreCase) { + EliUpCaseStr(pat); + EliUpCaseStr(ref); + } + ref2 = ref; + if (*pat) { + while (looping) { + if (!(*ref)) + looping = FALSE; + else { + if (!(ptr2 = (char *) index(ref, *pat))) + looping = FALSE; + else + if (!(looping = strncmp(pat, ptr2, len))) + place = ptr2; + ref = ptr2 + 1; + } + } + if (place) + place = orig + (place - ref2); + } + free(pat); + free(ref2); + return (place); + } + + char *eliStrCat(s1, s2) + char *s1, *s2; + { + char *buf = NULL; + int s1len = strlen(s1), len = 1 + s1len + strlen(s2); + + buf = EliStringOpBuf(len); + if (buf) { + strcpy(buf, s1); + strcpy(buf + s1len, s2); + } + return (buf); + } + + /* The next bit deals with the library mechanism. */ + + static eliCountElts(s) + char *s; + { + int tot = 0; + + if (s) { + ++tot; + while (*s) { + if (*s++ == ':') + ++tot; + } + } + return (tot); + } + + + static eliInitLibraries(st) + EliState_t *st; + { + int numelts, whichelt; + char *elilib = NULL, *clientlib = NULL, *s; + + elilib = getprofile("ELIPATH"); + if (!elilib) { + elilib = EliSaveString(AndrewDir("/lib/eli")); + } + else + elilib = EliSaveString(elilib); + if (!elilib) + return (-1); /* Should raise an error here */ + if (st->ClientLibraryPreference) { + clientlib = getprofile(st->ClientLibraryPreference); + } + if (!clientlib) + clientlib = EliSaveString(st->DefaultClientLibraryPath); + else + clientlib = EliSaveString(clientlib); + numelts = eliCountElts(elilib) + eliCountElts(clientlib); + st->LibElts = (eliLibElts_t *) malloc((1 + numelts) * sizeof(eliLibElts_t)); + if (!st->LibElts) { + return (-1); /* Should raise an error here */ + } + whichelt = 0; + s = clientlib; + while (s) { + st->LibElts[whichelt].dir = s; + st->LibElts[whichelt++].ext = st->DefaultClientExtension; + s = index(s, ':'); + if (s) + *s++ = '\0'; + } + s = elilib; + while (s) { + st->LibElts[whichelt].dir = s; + st->LibElts[whichelt++].ext = "eli"; + s = index(s, ':'); + if (s) + *s++ = '\0'; + } + st->LibElts[whichelt].dir = NULL; + st->LibElts[whichelt].ext = NULL; + return (0); + } + + static eliLoadFromLibrary(st, resbuf, loadfileSexp) + EliState_t *st; + EliSexp_t *resbuf, *loadfileSexp; + { + char FileName[1 + MAXPATHLEN], *loadfile; + int i, unixErr = 0; + short FoundIt = FALSE; + + if (!(st->initializedLibraries)) { + if (eliInitLibraries(st)) + return; /* should raise an error here */ + else + st->initializedLibraries = TRUE; + } + loadfile = EliStr_GetString(EliSexp_GetStr(loadfileSexp)); + for (i = 0; st->LibElts[i].dir; ++i) { + strcpy(FileName, st->LibElts[i].dir); + strcat(FileName, "/"); + strcat(FileName, loadfile); + if (!access(FileName, R_OK)) { + FoundIt = TRUE; + break; + } + else { + if (errno != ENOENT) { + unixErr = errno; + break; + } + } + strcat(FileName, "."); + strcat(FileName, st->LibElts[i].ext); + if (!access(FileName, R_OK)) { + FoundIt = TRUE; + break; + } + else { + if (errno != ENOENT) { + unixErr = errno; + break; + } + } + } + if (FoundIt) { + char Bogoid[25 + MAXPATHLEN]; /* BOGUS -- perhaps bobg + * can optimize? */ + EliSexp_t *sexp; + + sprintf(Bogoid, "(read \"%s\")", FileName); + + if (!(sexp = eliSGetSexp_trace(st, EliTraceStk(st), Bogoid))) + return; + eliEval(st, sexp, resbuf); + /* if (EliErr_ErrP(st)) return; */ + } + else { + EliError(st, ELI_ERR_BAD_ARGS, loadfileSexp, "ELI-PRIMITIVE [LOAD (error opening file)]", unixErr ? unixErr : ENOENT); + return; + } + } + + /***** BEGIN DEFINITIONS OF LISP FUNCTIONS HERE *****/ + + + void Prim_DOSTAR(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliCons_t *consptr, *consptr2, *vars = NULL, *constmp, *endstuff; + EliSexp_t *nodeptr, *resnode, *nodetmp, *nodeerr, *varsnode, *body = NULL, *bindval, *oneMoreTmp; + EliSym_t *symtmp, *symtmp2; + int looping = TRUE, i, l3, l2, l = EliListLen(arglist), varsp, numvars = 0, bound = 0; + + EliDebug(20, "Entering primitive DO*", st, FALSE); + if ((l < 2) || (l > 3)) { + if (!(nodeerr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, nodeerr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, nodeerr, "ELI-PRIMITIVE [DO* (checking arglist size)]", 0); + } + varsnode = EliCons_GetCar(arglist); + if ((EliSexp_GetType(varsnode) != e_data_list) && !EliNilP(st, varsnode)) { + EliError(st, ELI_ERR_BAD_ARGS, varsnode, "ELI-PRIMITIVE [DO* (1st arg not a list)]", 0); + return; + } + if (varsp = !EliNilP(st, varsnode)) + numvars = EliListLen(vars = EliSexp_GetCons(varsnode)); + nodetmp = EliCons_GetCdr(arglist); + constmp = EliSexp_GetCons(nodetmp); + nodetmp = EliCons_GetCar(constmp); + if (EliSexp_GetType(nodetmp) != e_data_list) { + EliError(st, ELI_ERR_BAD_ARGS, nodetmp, "ELI-PRIMITIVE [DO* (2nd arg not a list)]", 0); + return; + } + l2 = EliListLen(endstuff = EliSexp_GetCons(nodetmp)); + if ((l2 < 1) || (l2 > 2)) { + EliError(st, ELI_ERR_BAD_ARGS, nodetmp, "ELI-PRIMITIVE [DO* (2nd arg not 1 or 2 elements long)]", 0); + return; + } + if (l == 3) { + nodetmp = EliCons_GetCdr(constmp); + constmp = EliSexp_GetCons(nodetmp); + body = EliCons_GetCar(constmp); + } + if (varsp) { + consptr = vars; + for (i = 0; i < numvars; ++i) { + nodeptr = EliCons_GetCar(consptr); + if (EliSexp_GetType(nodeptr) != e_data_list) { + EliError(st, ELI_ERR_BAD_ARGS, nodeptr, "ELI-PRIMITIVE [DO* (1st arg contains a non-list element)]", 0); + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + l3 = EliListLen(consptr2 = EliSexp_GetCons(nodeptr)); + /* This is a sublist (vari initi stepi) */ + if ((l3 < 1) || (l3 > 3)) { + EliError(st, ELI_ERR_BAD_ARGS, nodeptr, "ELI-PRIMITIVE [DO* (1st arg contains a list with wrong size)]", 0); + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + nodeptr = EliCons_GetCar(consptr2); + if (EliSexp_GetType(nodeptr) != e_data_symbol) { + EliError(st, ELI_ERR_BAD_ARGS, nodeptr, "ELI-PRIMITIVE [DO* (1st arg contains a binding to a non-symbol)]", 0); + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + symtmp = EliSexp_GetSym(nodeptr); + if (!(symtmp2 = eliSym_GetNew_trace(st, EliTraceStk(st), EliSym_GetName(symtmp)))) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + if (l3 == 1) { + if (!(oneMoreTmp = EliSexp_GetNew(st))) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + EliSexp_SetSym(st, oneMoreTmp, EliNilSym(st)); + EliSym_BindSexp(st, symtmp2, oneMoreTmp); + } + else { + nodeptr = EliCons_GetCdr(consptr2); + consptr2 = EliSexp_GetCons(nodeptr); + nodeptr = EliCons_GetCar(consptr2); + if (!(bindval = eliSexp_GetNew_trace(st, EliTraceStk(st)))) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + eliEval(st, nodeptr, bindval); + if (EliErr_ErrP(st)) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + EliSym_BindSexp(st, symtmp2, bindval); + } + if (!eliEvalStk_Push(st, EliEvalStack(st), symtmp2)) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [DO* (pushing symbol)]", 0); + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + ++bound; + nodeptr = EliCons_GetCdr(consptr); + if (EliSexp_GetType(nodeptr) == e_data_list) + consptr = EliSexp_GetCons(nodeptr); + } + } + + /* Now begin the loop: test the end-clause, assign result-clause to resbuf + * if it's non-nil and return; if it's nil, evaluate the body (if any), + * then update all the variables. + */ + + if (!(resnode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + while (looping) { + nodeptr = EliCons_GetCar(endstuff); + eliEval(st, nodeptr, resnode); + if (EliErr_ErrP(st)) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + if (EliNilP(st, resnode)) { + if (l == 3) { /* That is to say, if there exists a + * body */ + eliEval(st, body, resnode); + if (EliErr_ErrP(st)) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + } + /* Now update vars */ + if (varsp) { + consptr = vars; + for (i = 0; i < numvars; ++i) { + nodeptr = EliCons_GetCar(consptr); + if (EliSexp_GetType(nodeptr) != e_data_list) { + EliError(st, ELI_ERR_BAD_ARGS, nodeptr, "ELI-PRIMITIVE [DO* (1st arg contains a non-list element [in update])]", 0); + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + l3 = EliListLen(consptr2 = EliSexp_GetCons(nodeptr)); + /* This is a sublist (vari initi stepi) */ + if ((l3 < 1) || (l3 > 3)) { + EliError(st, ELI_ERR_BAD_ARGS, nodeptr, "ELI-PRIMITIVE [DO* (1st arg contains a list with wrong size [in update])]", 0); + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + nodeptr = EliCons_GetCar(consptr2); + if (EliSexp_GetType(nodeptr) != e_data_symbol) { + EliError(st, ELI_ERR_BAD_ARGS, nodeptr, "ELI-PRIMITIVE [DO* (1st arg contains a binding to a non-symbol [in update])]", 0); + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + symtmp = EliSexp_GetSym(nodeptr); + symtmp2 = EliFindSym(st, EliStr_GetString(EliSym_GetName(symtmp))); + if (l3 == 3) { /* That is, if there's a step clause */ + nodeptr = EliCons_GetCdr(consptr2); + consptr2 = EliSexp_GetCons(nodeptr); + nodeptr = EliCons_GetCdr(consptr2); + consptr2 = EliSexp_GetCons(nodeptr); + nodeptr = EliCons_GetCar(consptr2); + if (!(bindval = eliSexp_GetNew_trace(st, EliTraceStk(st)))) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + eliEval(st, nodeptr, bindval); + if (EliErr_ErrP(st)) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + EliSym_BindSexp(st, symtmp2, bindval); + } + nodeptr = EliCons_GetCdr(consptr); + if (EliSexp_GetType(nodeptr) == e_data_list) + consptr = EliSexp_GetCons(nodeptr); + } + } + } + else + looping = FALSE; + } + /* Now evaluate result clause into resbuf */ + if (l2 == 1) /* That is to say, no result clause */ + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + else { + nodeptr = EliCons_GetCdr(endstuff); + consptr = EliSexp_GetCons(nodeptr); + nodeptr = EliCons_GetCar(consptr); + eliEval(st, nodeptr, resbuf); + if (EliErr_ErrP(st)) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + } + eliEvalStk_PopN(st, EliEvalStack(st), bound); + } + + void Prim_READ(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *err, *sexp, *evaledSexp; + eliDataTypes_t typeV[1]; + int evalV[1], paramStat, exit = FALSE; + FILE *fp, *fopen(); + EliCons_t *resultList = NULL; + + EliDebug(20, "Entering primitive READ", st, FALSE); + typeV[0] = e_data_string; + evalV[0] = TRUE; + paramStat = EliProcessList(st, arglist, 0, 1, args, &err, typeV, evalV); + if ((paramStat == -1) || (paramStat == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [READ (checking arglist size)]", 0); + return; + } + if (paramStat == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [READ (arg is not a string)]", 0); + return; + } + if (paramStat < 0) + return; + if (paramStat) { + if (!(fp = fopen(EliStr_GetString(EliSexp_GetStr(args[0])), "r"))) { + EliError(st, ELI_ERR_BAD_ARGS, args[0], "ELI-PRIMITIVE [READ (error opening file)]", errno); + return; + } + while (!exit) { + if (!(sexp = EliFGetSexp(st, fp))) { + fclose(fp); + return; + } + exit = EliProcessInfo.u_wrap; + if (!exit) { + if (!(evaledSexp = EliEval(st, sexp))) { + fclose(fp); + return; + } + if (!(resultList = EliAddToList(st, resultList, evaledSexp))) { + fclose(fp); + return; + } + } + } + fclose(fp); + if (resultList) + EliSexp_SetCons(st, resbuf, resultList); + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + else { + if (!(sexp = EliGetSexp(st))) + return; + EliSexp_SetSexp(st, resbuf, sexp); + } + } + + void Prim_CONSP(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *tmp, *err; + + EliDebug(20, "Entering primitive CONSP", st, FALSE); + if (1 != EliGetListCars(arglist, args, 1)) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [CONSP (checking arglist size)]", 0); + return; + } + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], tmp); + if (EliErr_ErrP(st)) + return; + EliSexp_SetSym(st, resbuf, ((EliSexp_GetType(tmp) == e_data_list) || EliNilP(st, tmp)) ? EliTSym(st) : EliNilSym(st)); + } + + void Prim_STRINGP(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *tmp, *err; + + EliDebug(20, "Entering primitive STRINGP", st, FALSE); + if (1 != EliGetListCars(arglist, args, 1)) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [STRINGP (checking arglist size)]", 0); + return; + } + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], tmp); + if (EliErr_ErrP(st)) + return; + EliSexp_SetSym(st, resbuf, (EliSexp_GetType(tmp) == e_data_string) ? EliTSym(st) : EliNilSym(st)); + } + + void Prim_ATOM(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *tmp, *err; + int atomic; + eliDataTypes_t tmptype; + + EliDebug(20, "Entering primitive ATOM", st, FALSE); + if (1 != EliGetListCars(arglist, args, 1)) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [ATOM (checking arglist size)]", 0); + return; + } + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], tmp); + if (EliErr_ErrP(st)) + return; + tmptype = EliSexp_GetType(tmp); + atomic = (tmptype == e_data_symbol) || (tmptype == e_data_integer) || (tmptype == e_data_string) || EliNilP(st, tmp); + EliSexp_SetSym(st, resbuf, atomic ? EliTSym(st) : EliNilSym(st)); + } + + void Prim_NUMBERP(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *tmp, *err; + + EliDebug(20, "Entering primitive NUMBERP", st, FALSE); + if (1 != EliGetListCars(arglist, args, 1)) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [NUMBERP (checking arglist size)]", 0); + return; + } + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], tmp); + if (EliErr_ErrP(st)) + return; + EliSexp_SetSym(st, resbuf, (EliSexp_GetType(tmp) == e_data_integer) ? EliTSym(st) : EliNilSym(st)); + } + + void Prim_LESSP(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[2], *tmp1, *tmp2, *err; + + EliDebug(20, "Entering primitive LESSP", st, FALSE); + if (2 != EliGetListCars(arglist, args, 2)) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [LESSP (checking arglist size)]", 0); + return; + } + if (!(tmp1 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], tmp1); + if (EliErr_ErrP(st)) + return; + if (!(tmp2 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[1], tmp2); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(tmp1) != e_data_integer) { + EliError(st, ELI_ERR_BAD_ARGS, tmp1, "ELI-PRIMITIVE [LESSP (1st arg not an int)]", 0); + return; + } + if (EliSexp_GetType(tmp2) != e_data_integer) { + EliError(st, ELI_ERR_BAD_ARGS, tmp2, "ELI-PRIMITIVE [LESSP (2nd arg not an int)]", 0); + return; + } + EliSexp_SetSym(st, resbuf, (EliSexp_GetInt(tmp1) < EliSexp_GetInt(tmp2)) ? EliTSym(st) : EliNilSym(st)); + } + + void Prim_BOUNDP(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *err, *tmp; + EliSym_t *symtmp; + + EliDebug(20, "Entering primitive BOUNDP", st, FALSE); + if (1 != EliGetListCars(arglist, args, 1)) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [BOUNDP (checking arglist size)]", 0); + return; + } + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], tmp); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(tmp) != e_data_symbol) { + EliError(st, ELI_ERR_BAD_ARGS, tmp, "ELI-PRIMITIVE [BOUNDP (arg is not a symbol)]", 0); + return; + } + if (!(symtmp = EliFindSym(st, EliStr_GetString(EliSym_GetName(EliSexp_GetSym(tmp)))))) + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + else { + if (EliSexp_GetType(EliSym_GetSexp(symtmp)) == e_data_none) + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + else + EliSexp_SetSym(st, resbuf, EliTSym(st)); + } + } + + void Prim_MINUS(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[2], *err; + eliDataTypes_t typeV[2]; + int evalV[2], paramStat; + + EliDebug(20, "Entering primitive MINUS", st, FALSE); + typeV[0] = typeV[1] = e_data_integer; + evalV[0] = evalV[1] = TRUE; + paramStat = EliProcessList(st, arglist, 1, 2, args, &err, typeV, evalV); + if ((paramStat == -1) || (paramStat == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [MINUS (checking arglist size)]", 0); + return; + } + if (paramStat == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [MINUS (1st arg not an int)]", 0); + return; + } + if (paramStat == -1001) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [MINUS (2nd arg not an int)]", 0); + return; + } + if (paramStat < 0) + return; + if (paramStat == 1) + EliSexp_SetInt(st, resbuf, -EliSexp_GetInt(args[0])); + else + EliSexp_SetInt(st, resbuf, EliSexp_GetInt(args[0]) - EliSexp_GetInt(args[1])); + } + + void Prim_TIMES(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliCons_t *argptr = arglist; + EliSexp_t *curarg, *evalarg, *tmp, *tmperr; + int args = EliListLen(arglist), i; + long result = 1L; + + EliDebug(20, "Entering primitive TIMES", st, FALSE); + if (!args) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [TIMES (checking arglist size)]", 0); + return; + } + for (i = 0; i < args; ++i) { + curarg = EliCons_GetCar(argptr); + if (!(evalarg = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, curarg, evalarg); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(evalarg) != e_data_integer) { + EliError(st, ELI_ERR_BAD_ARGS, evalarg, "ELI-PRIMITIVE [TIMES (an arg is not an int)]", 0); + return; + } + result *= EliSexp_GetInt(evalarg); + if (i < args - 1) { + tmp = EliCons_GetCdr(argptr); + argptr = EliSexp_GetCons(tmp); + } + } + EliSexp_SetInt(st, resbuf, result); + } + + void Prim_DIV(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[2], *tmp1, *tmp2, *err; + long longtmp; + + EliDebug(20, "Entering primitive DIV", st, FALSE); + if (2 != EliGetListCars(arglist, args, 2)) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [DIV (checking arglist size)]", 0); + return; + } + if (!(tmp1 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], tmp1); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(tmp1) != e_data_integer) { + EliError(st, ELI_ERR_BAD_ARGS, tmp1, "ELI-PRIMITIVE [DIV (1st arg not an int)]", 0); + return; + } + if (!(tmp2 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[1], tmp2); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(tmp2) != e_data_integer) { + EliError(st, ELI_ERR_BAD_ARGS, tmp2, "ELI-PRIMITIVE [DIV (2nd arg not an int)]", 0); + return; + } + if ((longtmp = EliSexp_GetInt(tmp2)) == 0L) { + EliError(st, ELI_ERR_BAD_ARGS, tmp2, "ELI-PRIMITIVE [DIV (division by zero)]", 0); + return; + } + EliSexp_SetInt(st, resbuf, (long) (EliSexp_GetInt(tmp1) / longtmp)); + } + + void Prim_STRCAT(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t **args, *err; + eliDataTypes_t *typeV; + int *evalV, len = EliListLen(arglist), paramStat, i, resultLen = 1; + EliStr_t *strTmp; + char *thisStr, *buf, *bufPtr; + static char errStr[80]; + + EliDebug(20, "Entering primitive STRCAT", st, FALSE); + if (len < 1) { + if (!(err = EliSexp_GetNew(st))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [STRCAT (checking arglist size)]", 0); + return; + } + if (!(args = (EliSexp_t **) malloc(len * sizeof(EliSexp_t *)))) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [STRCAT (allocating object array)]", 0); + return; + } + if (!(typeV = (eliDataTypes_t *) malloc(len * sizeof(eliDataTypes_t *)))) { + free(args); + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [STRCAT (allocating type array)]", 0); + return; + } + if (!(evalV = (int *) malloc(len * sizeof(int)))) { + free(args); + free(typeV); + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [STRCAT (allocating eval array)]", 0); + return; + } + for (i = 0; i < len; ++i) { + typeV[i] = e_data_string; + evalV[i] = TRUE; + } + paramStat = EliProcessList(st, arglist, 1, len, args, &err, typeV, evalV); + free(typeV); + free(evalV); + if (paramStat <= -2000) { + free(args); + return; + } + if (paramStat <= -1000) { + free(args); + sprintf(errStr, "ELI-PRIMITIVE [STRCAT (arg %d is not a string)]", 1 - (paramStat + 1000)); + EliError(st, ELI_ERR_BAD_ARGS, err, errStr, 0); + return; + } + for (i = 0; i < len; ++i) + resultLen += strlen(EliStr_GetString(EliSexp_GetStr(args[i]))); + if (!(buf = bufPtr = EliStringOpBuf(resultLen))) { + free(args); + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [STRCAT (allocating result string)]", 0); + return; + } + for (i = 0; i < len; ++i) { + strcpy(bufPtr, thisStr = EliStr_GetString(EliSexp_GetStr(args[i]))); + bufPtr += strlen(thisStr); + } + free(args); + if (!(strTmp = eliStringTable_FindOrMake(st, EliStringTable(st), buf))) + return; + EliSexp_SetStr(st, resbuf, strTmp); + } + + /* This one is called (index string char) [where the char is a one-character + * string type]. Like index(3), it returns the first substring (left-to-right) + * of string that begins with char. If char is a more-than-one-character + * string, only the first character is significant. If there is no such substring, + * NIL is returned. + */ + void Prim_INDEX(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[2], *restmp, *err; + EliStr_t *str1, *str2, *yaStr; + char *cptr; + + EliDebug(20, "Entering primitive INDEX", st, FALSE); + if (EliGetListCars(arglist, args, 2) != 2) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [INDEX (checking arglist size)]", 0); + return; + } + if (!(restmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], restmp); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(restmp) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, restmp, "ELI-PRIMITIVE [INDEX (1st arg not a string)]", 0); + return; + } + str1 = EliSexp_GetStr(restmp); + eliEval(st, args[1], restmp); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(restmp) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, restmp, "ELI-PRIMITIVE [INDEX (2nd arg not a string)]", 0); + return; + } + str2 = EliSexp_GetStr(restmp); + cptr = index(EliStr_GetString(str1), *(EliStr_GetString(str2))); + if (cptr) { + if (!(yaStr = eliStringTable_FindOrMake(st, EliStringTable(st), cptr))) + return; + else + EliSexp_SetStr(st, resbuf, yaStr); + } + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + + void Prim_RINDEX(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[2], *restmp, *err; + EliStr_t *str1, *str2; + char *cptr; + + EliDebug(20, "Entering primitive RINDEX", st, FALSE); + if (EliGetListCars(arglist, args, 2) != 2) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [RINDEX (checking arglist size)]", 0); + return; + } + if (!(restmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], restmp); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(restmp) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, restmp, "ELI-PRIMITIVE [RINDEX (1st arg not a string)]", 0); + return; + } + str1 = EliSexp_GetStr(restmp); + eliEval(st, args[1], restmp); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(restmp) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, restmp, "ELI-PRIMITIVE [RINDEX (2nd arg not a string)]", 0); + return; + } + str2 = EliSexp_GetStr(restmp); + cptr = rindex(EliStr_GetString(str1), *(EliStr_GetString(str2))); + if (cptr) + EliSexp_SetStr(st, resbuf, eliStringTable_FindOrMake(st, EliStringTable(st), cptr)); + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + + void Prim_STRDECOMPOSE(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[3], *err, *tmp; + EliStr_t *strNodes[3]; + int ignoreCase, processResult, evalV[3]; + EliCons_t *resultList = NULL; + eliDataTypes_t argV[3]; + char *pat, *ref, c, *foundLoc, *hold; + + EliDebug(20, "Entering primitive STRDECOMPOSE", st, FALSE); + argV[0] = argV[1] = e_data_string; + argV[2] = e_data_none; + evalV[0] = evalV[1] = evalV[2] = TRUE; + processResult = EliProcessList(st, arglist, 2, 3, args, &err, argV, evalV); + if ((processResult == -1) || (processResult == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [STRDECOMPOSE (checking arglist size)]", 0); + return; + } + if (processResult == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [STRDECOMPOSE (1st arg is not a string)]", 0); + return; + } + if (processResult == -1001) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [STRDECOMPOSE (2nd arg is not a string)]", 0); + return; + } + if (processResult < 0) + return; + pat = EliStr_GetString(EliSexp_GetStr(args[0])); + ref = EliStr_GetString(EliSexp_GetStr(args[1])); + ignoreCase = ((processResult == 3) && !EliNilP(st, args[2])); + + if (foundLoc = eliFindPrefix(pat, ref, ignoreCase)) { + + c = *foundLoc; + *foundLoc = '\0'; + if (!(hold = EliSaveString(ref))) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [STRDECOMPOSE (allocating space for 1st result string)]", 0); + return; + } + *foundLoc = c; + if (!(strNodes[0] = EliStringTable_FindOrMake(st, hold))) + return; + free(hold); + + c = *(foundLoc + strlen(pat)); + *(foundLoc + strlen(pat)) = '\0'; + if (!(hold = EliSaveString(foundLoc))) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [STRDECOMPOSE (allocating space for 2nd result string)]", 0); + return; + } + *(foundLoc + strlen(pat)) = c; + if (!(strNodes[1] = EliStringTable_FindOrMake(st, hold))) + return; + free(hold); + + if (!(strNodes[2] = EliStringTable_FindOrMake(st, (foundLoc + strlen(pat))))) + return; + + if (!(tmp = EliSexp_GetNew(st))) + return; + EliSexp_SetStr(st, tmp, strNodes[0]); + if (!(resultList = EliAddToList(st, resultList, tmp))) + return; + if (!(tmp = EliSexp_GetNew(st))) + return; + EliSexp_SetStr(st, tmp, strNodes[1]); + if (!(resultList = EliAddToList(st, resultList, tmp))) + return; + if (!(tmp = EliSexp_GetNew(st))) + return; + EliSexp_SetStr(st, tmp, strNodes[2]); + if (!(resultList = EliAddToList(st, resultList, tmp))) + return; + EliSexp_SetCons(st, resbuf, resultList); + } + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + + void Prim_STRLEN(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *err, *tmp; + + EliDebug(20, "Entering primitive STRLEN", st, FALSE); + if (EliGetListCars(arglist, args, 1) != 1) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [STRLEN (checking arglist size)]", 0); + return; + } + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], tmp); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(tmp) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, tmp, "ELI-PRIMITIVE [STRLEN (arg is not a string)]", 0); + return; + } + EliSexp_SetInt(st, resbuf, (long) strlen(EliStr_GetString(EliSexp_GetStr(tmp)))); + } + + void Prim_LCSTRING(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *err, *nodetmp; + char *oldstring, *oldptr, *newptr, c; + int len; + char *buf = NULL; + EliStr_t *newstr; + + EliDebug(20, "Entering primitive LCSTRING", st, FALSE); + if (EliGetListCars(arglist, args, 1) != 1) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [LCSTRING (checking arglist size)]", 0); + return; + } + if (!(nodetmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], nodetmp); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(nodetmp) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, nodetmp, "ELI-PRIMITIVE [LCSTRING (arg is not a string)]", 0); + return; + } + oldstring = EliStr_GetString(EliSexp_GetStr(nodetmp)); + len = strlen(oldstring) + 1; + if (!(buf = EliStringOpBuf(len))) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [LCSTRING (allocating result string)]", 0); + return; + } + for (oldptr = oldstring, newptr = buf; (*newptr) = (isupper((c = (*oldptr))) ? tolower(c) : c); ++oldptr, ++newptr); + if (!(newstr = eliStringTable_FindOrMake(st, EliStringTable(st), buf))) + return; + EliSexp_SetStr(st, resbuf, newstr); + } + + void Prim_APPEND(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *thisnode, *evalnode, *aNode, *anotherNode, *yetAnotherNode; + EliCons_t *thisarg, *reslist = NULL, *lastcell = NULL, *newcell, *aCell; + int l = EliListLen(arglist), looping, i; + + EliDebug(20, "Entering primitive APPEND", st, FALSE); + if (l) { + thisarg = arglist; + for (i = 0; i < l; ++i) { + thisnode = EliCons_GetCar(thisarg); + if (!(evalnode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, thisnode, evalnode); + if (EliErr_ErrP(st)) + return; + if (!EliNilP(st, evalnode)) { + if (EliSexp_GetType(evalnode) == e_data_list) { + aNode = evalnode; + looping = TRUE; + while (looping) { + aCell = EliSexp_GetCons(aNode); + anotherNode = EliCons_GetCar(aCell); + if (!(newcell = eliCons_GetNew_trace(st, EliTraceStk(st)))) + return; + EliCons_BindCar(st, newcell, anotherNode); + if (lastcell) { + if (!(yetAnotherNode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, yetAnotherNode, newcell); + EliCons_BindCdr(st, lastcell, yetAnotherNode); + lastcell = newcell; + } + else + reslist = lastcell = newcell; + aNode = EliCons_GetCdr(aCell); + looping = (EliSexp_GetType(aNode) == e_data_list); + } + } + else { + EliError(st, ELI_ERR_BAD_ARGS, evalnode, "ELI-PRIMITIVE [APPEND (an arg is not a list)]", 0); + return; + } + } + thisarg = EliGetNextCell(thisarg); + } + } + if (reslist) + EliSexp_SetCons(st, resbuf, reslist); + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + + void Prim_RE_STRCONTAINS(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[3], *err, *patNode, *refNode; + int numargs, rxpResult; + char *pat, *ref; + regexp *rptr, *regcomp(); + + EliDebug(20, "Entering primitive RE-STRCONTAINS", st, FALSE); + numargs = EliGetListCars(arglist, args, 2); + if (numargs < 2) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [RE-STRCONTAINS (checking arglist size)]", 0); + return; + } + if (!(patNode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], patNode); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(patNode) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, patNode, "ELI-PRIMITIVE [RE-STRCONTAINS (1st arg not a string)]", 0); + return; + } + pat = EliStr_GetString(EliSexp_GetStr(patNode)); + if (!(refNode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[1], refNode); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(refNode) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, refNode, "ELI-PRIMITIVE [RE-STRCONTAINS (2nd arg not a string)]", 0); + return; + } + ref = EliStr_GetString(EliSexp_GetStr(refNode)); + if (!(rptr = regcomp(pat))) { + EliError(st, ELI_ERR_BAD_ARGS, patNode, "ELI-PRIMITIVE [RE-STRCONTAINS (compiling regular expression)]", 0); + return; + } + rxpResult = regexec(rptr, ref); + free(rptr); + if (rxpResult) + EliSexp_SetSym(st, resbuf, EliTSym(st)); + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + + /* This one gets called (substring str start len) where the first character + * is numbered 0 + * + * By the way, I really overdid it with the error checking here. + */ + void Prim_SUBSTRING(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[3], *err, *evalnode; + EliStr_t *theStringNode, *result; + long start, len; + int theLen; + char *buf, *theString; + + EliDebug(20, "Entering primitive SUBSTRING", st, FALSE); + if (3 != EliGetListCars(arglist, args, 3)) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [SUBSTRING (checking arglist size)]", 0); + return; + } + if (!(evalnode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], evalnode); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(evalnode) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, evalnode, "ELI-PRIMITIVE [SUBSTRING (1st arg not a string)]", 0); + return; + } + theStringNode = EliSexp_GetStr(evalnode); + eliEval(st, args[1], evalnode); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(evalnode) != e_data_integer) { + EliError(st, ELI_ERR_BAD_ARGS, evalnode, "ELI-PRIMITIVE [SUBSTRING (2nd arg not an int)]", 0); + return; + } + start = EliSexp_GetInt(evalnode); + eliEval(st, args[2], evalnode); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(evalnode) != e_data_integer) { + EliError(st, ELI_ERR_BAD_ARGS, evalnode, "ELI-PRIMITIVE [SUBSTRING (3rd arg not an int)]", 0); + return; + } + len = EliSexp_GetInt(evalnode); + + if (start > ((long) (theLen = strlen(theString = EliStr_GetString(theStringNode))))) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetInt(st, err, start); + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [SUBSTRING (attempt to start past end of string)]", 0); + return; + } + if ((start + len) > ((long) theLen)) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetInt(st, err, len); + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [SUBSTRING (attempt to extract beyond end of string)]", 0); + return; + } + if (start < 0L) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetInt(st, err, start); + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [SUBSTRING (2nd arg less than zero)]", 0); + return; + } + if (len < 1L) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetInt(st, err, len); + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [SUBSTRING (3rd arg less than one)]", 0); + return; + } + if (!(buf = EliStringOpBuf((int) (len + 1L)))) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [SUBSTRING (allocating result string)]", 0); + return; + } + strncpy(buf, theString + start, (int) len); + buf[len] = '\0'; + if (!(result = eliStringTable_FindOrMake(st, EliStringTable(st), buf))) + return; + EliSexp_SetStr(st, resbuf, result); + } + + void Prim_SYMBOLP(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *tmp, *err; + + EliDebug(20, "Entering primitive SYMBOLP", st, FALSE); + if (1 != EliGetListCars(arglist, args, 1)) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [SYMBOLP (checking arglist size)]", 0); + return; + } + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], tmp); + if (EliErr_ErrP(st)) + return; + EliSexp_SetSym(st, resbuf, ((EliSexp_GetType(tmp) == e_data_symbol) || EliNilP(st, tmp)) ? EliTSym(st) : EliNilSym(st)); + } + + void Prim_PLUMBER(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *tmp, *err; + FILE *fp, *fopen(); + + EliDebug(20, "Entering primitive PLUMBER", st, FALSE); + if (1 != EliGetListCars(arglist, args, 1)) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [PLUMBER (checking arglist size)]", 0); + return; + } + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], tmp); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(tmp) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, tmp, "ELI-PRIMITIVE [PLUMBER (arg is not a string)]", 0); + return; + } + if (!(fp = fopen(EliStr_GetString(EliSexp_GetStr(tmp)), "w"))) { + EliError(st, ELI_ERR_BAD_ARGS, tmp, "ELI-PRIMITIVE [PLUMBER (error opening file)]", 0); + return; + } + #ifdef DEBUG_MALLOC_ENV + plumber(fp); + #else /* #ifdef DEBUG_MALLOC_ENV */ + fprintf(fp, "\nTHIS MODULE WAS COMPILED WITH DEBUG_MALLOC_ENV UNDEFINED.\n"); + #endif /* #ifdef DEBUG_MALLOC_ENV */ + fclose(fp); + EliSexp_SetSym(st, resbuf, EliTSym(st)); /* BOGUS -- change this to + * reflect something + * meaningful */ + } + + /* This primitive works something like strdecompose. + * The first argument is a regular expression + * The second is a reference string to match against. The optional + * third argument specifies whether to ignore case; i.e., if it's + * present, and non-nil, then ignore case. + */ + + void Prim_RE_STRDECOMPOSE(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[3], *err, *patNode, *refNode, *strs[3], *cdrs[2]; + int numargs, rxpResult; + char *pat, *ref, tempChar, *hold; + EliStr_t *strNodes[3]; + EliCons_t *consCells[3]; + regexp *rptr, *regcomp(); + + EliDebug(20, "Entering primitive RE-STRDECOMPOSE", st, FALSE); + numargs = EliGetListCars(arglist, args, 2); + if (numargs < 2) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [RE-STRDECOMPOSE (checking arglist size)]", 0); + return; + } + if (!(patNode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], patNode); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(patNode) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, patNode, "ELI-PRIMITIVE [RE-STRDECOMPOSE (1st arg not a string)]", 0); + return; + } + pat = EliStr_GetString(EliSexp_GetStr(patNode)); + if (!(refNode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[1], refNode); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(refNode) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, refNode, "ELI-PRIMITIVE [RE-STRDECOMPOSE (2nd arg not a string)]", 0); + return; + } + ref = EliStr_GetString(EliSexp_GetStr(refNode)); + if (!(rptr = regcomp(pat))) { + EliError(st, ELI_ERR_BAD_ARGS, patNode, "ELI-PRIMITIVE [RE-STRDECOMPOSE (compiling regular expression)]", 0); + return; + } + rxpResult = regexec(rptr, ref); + if (rxpResult) { + tempChar = *(rptr->startp[0]); + *(rptr->startp[0]) = '\0'; + if (!(hold = EliSaveString(ref))) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [RE-STRDECOMPOSE (allocating space for 1st result string)]", 0); + free(rptr); + return; + } + *(rptr->startp[0]) = tempChar; + strNodes[0] = eliStringTable_FindOrMake(st, EliStringTable(st), hold); + free(hold); + if (!(strNodes[0])) { + free(rptr); + return; + } + tempChar = *(rptr->endp[0]); + *(rptr->endp[0]) = '\0'; + if (!(hold = EliSaveString(rptr->startp[0]))) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [RE-STRDECOMPOSE (allocating space for 2nd result string)]", 0); + free(rptr); + return; + } + *(rptr->endp[0]) = tempChar; + strNodes[1] = eliStringTable_FindOrMake(st, EliStringTable(st), hold); + free(hold); + if (!(strNodes[1])) { + free(rptr); + return; + } + if (!(strNodes[2] = eliStringTable_FindOrMake(st, EliStringTable(st), rptr->endp[0]))) { + free(rptr); + return; + } + free(rptr); + + /* + * Three string nodes are now allocated; place them in sexp nodes and + * put them in a cons list + */ + if ((!(strs[0] = eliSexp_GetNew_trace(st, EliTraceStk(st)))) || (!(strs[1] = eliSexp_GetNew_trace(st, EliTraceStk(st)))) || (!(strs[2] = eliSexp_GetNew_trace(st, EliTraceStk(st))))) + return; + EliSexp_SetStr(st, strs[0], strNodes[0]); + EliSexp_SetStr(st, strs[1], strNodes[1]); + EliSexp_SetStr(st, strs[2], strNodes[2]); + if ((!(consCells[0] = eliCons_GetNew_trace(st, EliTraceStk(st)))) || (!(consCells[1] = eliCons_GetNew_trace(st, EliTraceStk(st)))) || (!(consCells[2] = eliCons_GetNew_trace(st, EliTraceStk(st))))) + return; + if ((!(cdrs[0] = eliSexp_GetNew_trace(st, EliTraceStk(st)))) || (!(cdrs[1] = eliSexp_GetNew_trace(st, EliTraceStk(st))))) + return; + EliSexp_SetCons(st, cdrs[0], consCells[1]); + EliSexp_SetCons(st, cdrs[1], consCells[2]); + EliCons_BindCar(st, consCells[0], strs[0]); + EliCons_BindCdr(st, consCells[0], cdrs[0]); + EliCons_BindCar(st, consCells[1], strs[1]); + EliCons_BindCdr(st, consCells[1], cdrs[1]); + EliCons_BindCar(st, consCells[2], strs[2]); + EliSexp_SetCons(st, resbuf, consCells[0]); + } + else { + free(rptr); + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + } + + void Prim_GENSYM(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + static int num = 1; + char name[GENSYM_NAMELEN]; + EliSexp_t *err; + EliSym_t *symNode; + + EliDebug(20, "Entering primitive GENSYM", st, FALSE); + if (EliListLen(arglist)) { + if (!(err = eliSexp_GetNew_trace(st, st->g_errstk))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [GENSYM (checking arglist size)]", 0); + return; + } + do { + sprintf(name, "G#%X", num++); + } while (EliFindSym(st, name)); + if (!(symNode = eliSymTab_FindOrMake(st, EliTempSymTable(st), name))) + return; + eliSym_SetScope(symNode, e_sym_known); + EliSexp_SetSym(st, resbuf, symNode); + } + + void Prim_FUNCTION(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *err, *tmp; + EliFn_t *fnTmp; + eliFnTypes_t fnType; + + EliDebug(20, "Entering primitive FUNCTION", st, FALSE); + if (1 != EliGetListCars(arglist, args, 1)) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [FUNCTION (checking arglist size)]", 0); + return; + } + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], tmp); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(tmp) != e_data_symbol) { + EliError(st, ELI_ERR_BAD_ARGS, tmp, "ELI-PRIMITIVE [FUNCTION (arg is not a symbol)]", 0); + return; + } + if ((fnType = eliFn_GetType(fnTmp = EliSym_GetFn(EliSexp_GetSym(tmp)))) == e_fn_none) { + EliError(st, ELI_ERR_BAD_ARGS, tmp, "ELI-PRIMITIVE [FUNCTION (symbol has no function bound to it)]", 0); + return; + } + if (fnType == e_fn_compiled) + EliSexp_SetFn(st, resbuf, fnTmp); + else /* It's a list */ + EliSexp_SetCons(st, resbuf, eliFn_GetCons(fnTmp)); + } + + void Prim_LOAD(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *argnodes[1], *err, *resbuf2; + + EliDebug(20, "Entering primitive LOAD", st, FALSE); + if (EliGetListCars(arglist, argnodes, 1) != 1) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) { + return; + } + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [LOAD (checking arglist size)]", 0); + return; + } + if (!(resbuf2 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) { + return; + } + eliEval(st, argnodes[0], resbuf2); + if (EliErr_ErrP(st)) { + return; + } + if (EliSexp_GetType(resbuf2) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, resbuf2, "ELI-PRIMITIVE [LOAD (arg is not a string)]", 0); + return; + } + eliLoadFromLibrary(st, resbuf, resbuf2); + } + + static void BrokenPipeHandler() + { + longjmp(brokenPipeEnv, 1); + } + + static void AlarmHandler() + { + longjmp(alarmEnv, 1); + } + + /* + * The following primitive is called as: + * (filter [timeout] input cmd [arg1 [arg2 ... [argn]]]) + * and returns a list of the form: + * (ec output diag) + * + * The string "input" is passed as the standard input to the command named + * by "cmd" (whose arguments are given in arg1 ... argn, which are optional). + * Ec is the exit code of the command, output is a string containing + * its standard output, and diag is a string containing its diagnostic output + * If input evaluates to NIL, no stdin is passed to the child. + */ + + void Prim_FILTER(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + int i, childpid, stdinpipe[2], stdoutpipe[2], numchildcmdargs; + int stderrpipe[2], listlen = EliListLen(arglist), gavetimeout; + long timeoutsecs = (long) FILTERTIMEOUT; + char *childcmd, **childcmdargs = (char **) 0, *stdinstring = NULL; + EliSexp_t *tmpsexp, *err; + EliCons_t *argptr; + + if (listlen < 2) { + if (!(err = EliSexp_GetNew(st))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, + "ELI_PRIMITIVE [FILTER (checking arglist size)]", 0); + return; + } + + /* Check first arg; is it an integer? */ + if (!(tmpsexp = EliEval(st, EliCons_GetCar(arglist)))) + return; + if (EliSexp_GetType(tmpsexp) == e_data_integer) { + gavetimeout = TRUE; + numchildcmdargs = listlen - 1; + timeoutsecs = EliSexp_GetInt(tmpsexp); + if (timeoutsecs < ((long) 0)) { + EliError(st, ELI_ERR_BAD_ARGS, tmpsexp, + "ELI-PRIMITIVE [FILTER (invalid timeout value specified)]", 0); + return; + } + if (listlen < 3) { + if (!(err = EliSexp_GetNew(st))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, + "ELI_PRIMITIVE [FILTER (checking arglist size)]", 0); + return; + } + } + else { + gavetimeout = FALSE; + numchildcmdargs = listlen; + if (!EliNilP(st, tmpsexp)) { + if (EliSexp_GetType(tmpsexp) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, tmpsexp, + "ELI-PRIMITIVE [FILTER (`stdin' arg must be NIL or string)]", 0); + return; + } + stdinstring = EliStr_GetString(EliSexp_GetStr(tmpsexp)); + } + } + argptr = EliGetNextCell(arglist); + + if (!(childcmdargs = + (char **) malloc(numchildcmdargs * + (sizeof(char *))))) { + EliError(st, ELI_ERR_OUT_OF_MEM, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (allocating `argv' array)]", 0); + return; + } + + if (gavetimeout) { + if (!(tmpsexp = EliEval(st, EliCons_GetCar(argptr)))) { + free(childcmdargs); + return; + } + if (!EliNilP(st, tmpsexp)) { + if (EliSexp_GetType(tmpsexp) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, tmpsexp, + "ELI-PRIMITIVE [FILTER (`stdin' arg must be NIL or string)]", 0); + free(childcmdargs); + return; + } + stdinstring = EliStr_GetString(EliSexp_GetStr(tmpsexp)); + } + argptr = EliGetNextCell(argptr); + } + + if (!(tmpsexp = EliEval(st, EliCons_GetCar(argptr)))) { + free(childcmdargs); + return; + } + if (EliSexp_GetType(tmpsexp) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, tmpsexp, + "ELI-PRIMITIVE [FILTER (command arg must be a string)]", 0); + free(childcmdargs); + return; + } + childcmd = EliStr_GetString(EliSexp_GetStr(tmpsexp)); + + childcmdargs[0] = childcmd; + for (i = 1; argptr = EliGetNextCell(argptr); ++i) { + if (!(tmpsexp = EliEval(st, EliCons_GetCar(argptr)))) { + free(childcmdargs); + return; + } + if (EliSexp_GetType(tmpsexp) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, tmpsexp, + "ELI-PRIMITIVE [FILTER (a command option is not a string)]", 0); + free(childcmdargs); + return; + } + childcmdargs[i] = EliStr_GetString(EliSexp_GetStr(tmpsexp)); + } + childcmdargs[numchildcmdargs - 1] = NULL; + + if (pipe(stdinpipe)) { + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (opening stdin pipe)]", errno); + free(childcmdargs); + } + if (pipe(stdoutpipe)) { + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (opening stdout pipe)]", errno); + close(stdinpipe[0]); + close(stdinpipe[1]); + free(childcmdargs); + return; + } + if (pipe(stderrpipe)) { + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (opening stderr pipe)]", errno); + close(stdinpipe[0]); + close(stdinpipe[1]); + close(stdoutpipe[0]); + close(stdoutpipe[1]); + free(childcmdargs); + return; + } + + childpid = osi_vfork(); + + if (childpid > 0) { /* In parent */ + struct timeval timeout; + #ifdef FD_SET + fd_set readfdset, writefdset; + #else /* FD_SET */ + int readfdset, writefdset; + #endif /* FD_SET */ + int cc, remaining, rwlen; + int selectval, writing = (stdinstring != NULL), readingstdout = TRUE; + int readingstderr = TRUE, stdoutstrsize = 0, waitval; + int numdescriptors, stdoutstrused = 0, stderrstrsize = 0; + int stderrstrused = 0, (*oldpipefunc) (), (*oldalarmfunc) (); + char *stdinstrptr = stdinstring, *stdoutstr; + char *stderrstr, buffer[1 + FILTERBUFSIZ]; + union wait waitstat; + EliSexp_t *resultnodes[3]; + EliCons_t *reslist = (EliCons_t *) 0; + EliStr_t *resultstrs[2]; + struct itimerval itimer, olditimer; + + setpgrp(childpid, childpid); + + close(stdinpipe[0]); + close(stdoutpipe[1]); + close(stderrpipe[1]); + if (!writing) + close(stdinpipe[1]); + + if (!(stdoutstr = malloc(FILTERBUFSIZ))) { + EliError(st, ELI_ERR_OUT_OF_MEM, (EliSexp_t *) 0, "ELI-PRIMITIVE [FILTER (creating stdout buffer)]", 0); + if (writing) + close(stdinpipe[1]); + close(stdoutpipe[0]); + close(stderrpipe[0]); + free(childcmdargs); + killpg(childpid, SIGKILL); + return; + } + stdoutstrsize = FILTERBUFSIZ; + *stdoutstr = '\0'; + + if (!(stderrstr = malloc(FILTERBUFSIZ))) { + EliError(st, ELI_ERR_OUT_OF_MEM, (EliSexp_t *) 0, "ELI-PRIMITIVE [FILTER (creating stderr buffer)]", 0); + if (writing) + close(stdinpipe[1]); + close(stdoutpipe[0]); + close(stderrpipe[0]); + free(childcmdargs); + free(stdoutstr); + killpg(childpid, SIGKILL); + return; + } + stderrstrsize = FILTERBUFSIZ; + *stderrstr = '\0'; + + if (timeoutsecs) { + /* Set up a SIGALRM to go off after a certain timeout */ + itimer.it_interval.tv_sec = (long) 0; + itimer.it_interval.tv_usec = (long) 0; + itimer.it_value.tv_sec = (long) timeoutsecs; + itimer.it_value.tv_usec = (long) 0; + if (setjmp(alarmEnv)) { + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, "ELI-PRIMITIVE [FILTER (subprocess timed out)]", 0); + if (writing) + close(stdinpipe[1]); + close(stdoutpipe[0]); + close(stderrpipe[0]); + free(childcmdargs); + free(stdoutstr); + free(stderrstr); + killpg(childpid, SIGKILL); + + /* Restore old SIGALRM action */ + setitimer(ITIMER_REAL, &olditimer, (struct itimerval *) 0); + signal(SIGALRM, oldalarmfunc); + + /* Restore old SIGPIPE action */ + signal(SIGPIPE, oldpipefunc); + + return; + } + /* Bogus: should this timeout be real time or virtual time? */ + setitimer(ITIMER_REAL, &itimer, &olditimer); + oldalarmfunc = (int (*)()) signal(SIGALRM, AlarmHandler); + if (((int) oldalarmfunc) == -1) { + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (setting up timeout)]", errno); + if (writing) + close(stdinpipe[1]); + close(stdoutpipe[0]); + close(stderrpipe[0]); + free(childcmdargs); + free(stdoutstr); + free(stderrstr); + killpg(childpid, SIGKILL); + return; + } + } + + /* Set up SIGPIPE so we don't abort on broken pipe */ + if (setjmp(brokenPipeEnv)) { /* Handle SIGPIPE here */ + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (subprocess unexpectedly closed stdin)]", 0); + if (writing) + close(stdinpipe[1]); + close(stdoutpipe[0]); + close(stderrpipe[0]); + free(childcmdargs); + free(stdoutstr); + free(stderrstr); + killpg(childpid, SIGKILL); + + /* Restore old SIGALRM action */ + setitimer(ITIMER_REAL, &olditimer, (struct itimerval *) 0); + signal(SIGALRM, oldalarmfunc); + + /* Restore old SIGPIPE action */ + signal(SIGPIPE, oldpipefunc); + + return; + } + oldpipefunc = (int (*)()) signal(SIGPIPE, BrokenPipeHandler); + if (((int) oldpipefunc) == -1) { + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (setting up broken-pipe catcher)]", errno); + if (writing) + close(stdinpipe[1]); + close(stdoutpipe[0]); + close(stderrpipe[0]); + free(childcmdargs); + free(stdoutstr); + free(stderrstr); + killpg(childpid, SIGKILL); + + /* Restore old SIGALRM action */ + setitimer(ITIMER_REAL, &olditimer, (struct itimerval *) 0); + signal(SIGALRM, oldalarmfunc); + + return; + } + + while (readingstdout || readingstderr) { + if (writing) { + #ifdef FD_SET + FD_ZERO(&writefdset); + FD_SET(stdinpipe[1], &writefdset); + #else /* FD_SET */ + writefdset = 1 << stdinpipe[1]; + #endif /* FD_SET */ + timeout.tv_sec = (long) 0; + timeout.tv_usec = (long) 0; + selectval = select(stdinpipe[1] + 1, 0, + &writefdset, 0, + &timeout); + if (selectval > 0) { + remaining = strlen(stdinstrptr); + rwlen = (FILTERBUFSIZ < remaining) ? FILTERBUFSIZ : remaining; + if (rwlen) { + cc = write(stdinpipe[1], stdinstrptr, rwlen); + if (cc < 0) { + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (write to subprocess failed!)]", errno); + if (writing) + close(stdinpipe[1]); + close(stdoutpipe[0]); + close(stderrpipe[0]); + free(childcmdargs); + free(stdoutstr); + free(stderrstr); + killpg(childpid, SIGKILL); + + /* Restore old SIGALRM action */ + setitimer(ITIMER_REAL, &olditimer, (struct itimerval *) 0); + signal(SIGALRM, oldalarmfunc); + + /* Restore old SIGPIPE action */ + signal(SIGPIPE, oldpipefunc); + + return; + } + else { + stdinstrptr += cc; + } + } + else { /* rwlen is zero */ + close(stdinpipe[1]); + writing = FALSE; + } + } + else { + if (selectval < 0) { + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (select on write failed!)]", errno); + if (writing) + close(stdinpipe[1]); + if (readingstdout) + close(stdoutpipe[0]); + if (readingstderr) + close(stderrpipe[0]); + free(childcmdargs); + free(stdoutstr); + free(stderrstr); + killpg(childpid, SIGKILL); + + /* Restore old SIGALRM action */ + setitimer(ITIMER_REAL, &olditimer, (struct itimerval *) 0); + signal(SIGALRM, oldalarmfunc); + + /* Restore old SIGPIPE action */ + signal(SIGPIPE, oldpipefunc); + + return; + } + } + } + if (readingstdout || readingstderr) { + numdescriptors = -1; + #ifdef FD_SET + FD_ZERO(&readfdset); + #else /* FD_SET */ + readfdset = 0; + #endif /* FD_SET */ + if (readingstdout) { + #ifdef FD_SET + FD_SET(stdoutpipe[0], &readfdset); + #else /* FD_SET */ + readfdset = 1 << stdoutpipe[0]; + #endif /* FD_SET */ + numdescriptors = stdoutpipe[0]; + } + if (readingstderr) { + #ifdef FD_SET + FD_SET(stderrpipe[0], &readfdset); + #else /* FD_SET */ + readfdset |= 1 << stderrpipe[0]; + #endif /* FD_SET */ + if (stderrpipe[0] > numdescriptors) + numdescriptors = stderrpipe[0]; + } + timeout.tv_sec = (long) 0; + timeout.tv_usec = (long) 0; + selectval = select(1 + numdescriptors, &readfdset, + 0, 0, &timeout); + if (selectval > 0) { + #ifdef FD_SET + if (FD_ISSET(stdoutpipe[0], &readfdset)) { + #else /* FD_SET */ + if (readfdset & (1 << stdoutpipe[0])) { + #endif /* FD_SET */ + cc = read(stdoutpipe[0], buffer, FILTERBUFSIZ); + if (cc > 0) { + if ((cc + stdoutstrused + 1) > stdoutstrsize) { + if (!(stdoutstr = realloc(stdoutstr, stdoutstrsize + FILTERBUFSIZ + 1))) { + EliError(st, ELI_ERR_OUT_OF_MEM, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (growing stdout buffer)]", 0); + if (writing) + close(stdinpipe[1]); + close(stdoutpipe[0]); + if (readingstderr) + close(stderrpipe[0]); + free(childcmdargs); + free(stderrstr); + killpg(childpid, SIGKILL); + + /* Restore old SIGALRM action */ + setitimer(ITIMER_REAL, &olditimer, (struct itimerval *) 0); + signal(SIGALRM, oldalarmfunc); + + /* Restore old SIGPIPE action */ + signal(SIGPIPE, oldpipefunc); + + return; + } + stdoutstrsize += (FILTERBUFSIZ + 1); + } + bcopy(buffer, stdoutstr + stdoutstrused, cc); + stdoutstrused += cc; + } + else { + if (cc < 0) { + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (read from subprocess' stdout failed!)]", errno); + if (writing) + close(stdinpipe[1]); + close(stdoutpipe[0]); + if (readingstderr) + close(stderrpipe[0]); + free(childcmdargs); + free(stdoutstr); + free(stderrstr); + killpg(childpid, SIGKILL); + + /* Restore old SIGALRM action */ + setitimer(ITIMER_REAL, &olditimer, (struct itimerval *) 0); + signal(SIGALRM, oldalarmfunc); + + /* Restore old SIGPIPE action */ + signal(SIGPIPE, oldpipefunc); + + return; + } + else { + readingstdout = FALSE; + close(stdoutpipe[0]); + stdoutstr[stdoutstrused] = '\0'; + } + } + } + #ifdef FD_SET + if (FD_ISSET(stderrpipe[0], &readfdset)) { + #else /* FD_SET */ + if (readfdset & (1 << stderrpipe[0])) { + #endif /* FD_SET */ + cc = read(stderrpipe[0], buffer, FILTERBUFSIZ); + if (cc > 0) { + if ((cc + stderrstrused + 1) > stderrstrsize) { + if (!(stderrstr = realloc(stderrstr, stderrstrsize + FILTERBUFSIZ + 1))) { + EliError(st, ELI_ERR_OUT_OF_MEM, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (growing stderr buffer)]", 0); + if (writing) + close(stdinpipe[1]); + if (readingstdout) + close(stdoutpipe[0]); + close(stderrpipe[0]); + free(childcmdargs); + free(stderrstr); + killpg(childpid, SIGKILL); + + /* Restore old SIGALRM action */ + setitimer(ITIMER_REAL, &olditimer, (struct itimerval *) 0); + signal(SIGALRM, oldalarmfunc); + + /* Restore old SIGPIPE action */ + signal(SIGPIPE, oldpipefunc); + + return; + } + stderrstrsize += (FILTERBUFSIZ + 1); + } + bcopy(buffer, stderrstr + stderrstrused, cc); + stderrstrused += cc; + } + else { + if (cc < 0) { + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (read from subprocess' stderr failed!)]", errno); + if (writing) + close(stdinpipe[1]); + if (readingstdout) + close(stdoutpipe[0]); + close(stderrpipe[0]); + free(childcmdargs); + free(stdoutstr); + free(stderrstr); + killpg(childpid, SIGKILL); + + /* Restore old SIGALRM action */ + setitimer(ITIMER_REAL, &olditimer, (struct itimerval *) 0); + signal(SIGALRM, oldalarmfunc); + + /* Restore old SIGPIPE action */ + signal(SIGPIPE, oldpipefunc); + + return; + } + else { + readingstderr = FALSE; + close(stderrpipe[0]); + stderrstr[stderrstrused] = '\0'; + } + } + } + } + else { + if (selectval < 0) { + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (select on read failed!)]", errno); + if (writing) + close(stdinpipe[1]); + if (readingstdout) + close(stdoutpipe[0]); + if (readingstderr) + close(stderrpipe[0]); + free(childcmdargs); + free(stdoutstr); + free(stderrstr); + killpg(childpid, SIGKILL); + + /* Restore old SIGALRM action */ + setitimer(ITIMER_REAL, &olditimer, (struct itimerval *) 0); + signal(SIGALRM, oldalarmfunc); + + /* Restore old SIGPIPE action */ + signal(SIGPIPE, oldpipefunc); + + return; + } + } + } + } + + /* In case things aren't closed. I think they should be by now, + * but I also believe that it doesn't matter if you close a closed + * descriptor. + */ + close(stdinpipe[1]); + close(stdoutpipe[0]); + close(stdoutpipe[0]); + + if (timeoutsecs) { + /* Restore old SIGALRM action */ + setitimer(ITIMER_REAL, &olditimer, (struct itimerval *) 0); + signal(SIGALRM, oldalarmfunc); + } + + /* Restore old SIGPIPE action */ + signal(SIGPIPE, oldpipefunc); + + /* Wait for the child process to terminate */ + while ((waitval = wait(&waitstat)) != childpid) { + if (waitval < 0) { + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, + "ELI-PRIMITIVE [FILTER (wait failed!)]", errno); + free(childcmdargs); + free(stdoutstr); + free(stderrstr); + killpg(childpid, SIGKILL); + return; + } + } + + free(childcmdargs); + + /* Prepare return value */ + if (!(resultnodes[0] = EliSexp_GetNew(st))) { + free(stdoutstr); + free(stderrstr); + return; + } + if (!(resultnodes[1] = EliSexp_GetNew(st))) { + free(stdoutstr); + free(stderrstr); + return; + } + if (!(resultnodes[2] = EliSexp_GetNew(st))) { + free(stdoutstr); + free(stderrstr); + return; + } + if (!(resultstrs[0] = EliStringTable_FindOrMake(st, stdoutstr))) { + free(stdoutstr); + free(stderrstr); + return; + } + free(stdoutstr); + if (!(resultstrs[1] = EliStringTable_FindOrMake(st, stderrstr))) { + free(stderrstr); + return; + } + free(stderrstr); + EliSexp_SetInt(st, resultnodes[0], (int) waitstat.w_T.w_Retcode); + EliSexp_SetStr(st, resultnodes[1], resultstrs[0]); + EliSexp_SetStr(st, resultnodes[2], resultstrs[1]); + if (!(reslist = EliAddToList(st, reslist, resultnodes[0]))) + return; + if (!(reslist = EliAddToList(st, reslist, resultnodes[1]))) + return; + if (!(reslist = EliAddToList(st, reslist, resultnodes[2]))) + return; + EliSexp_SetCons(st, resbuf, reslist); + return; + } + else { + if (!childpid) { /* In child */ + + close(stdinpipe[1]); + close(stdoutpipe[0]); + close(stderrpipe[0]); + + if (dup2(stdinpipe[0], 0) == -1) { + close(stdinpipe[0]); + close(stdoutpipe[1]); + close(stderrpipe[1]); + _exit(0373); + } + close(stdinpipe[0]); + + if (dup2(stdoutpipe[1], 1) == -1) { + close(stdoutpipe[1]); + close(stderrpipe[1]); + _exit(0374); + } + close(stdoutpipe[1]); + + if (dup2(stderrpipe[1], 2) == -1) { + close(stderrpipe[1]); + _exit(0375); + } + close(stderrpipe[1]); + + execvp(childcmd, childcmdargs); + + + /* Bogus: do the following? */ + close(0); + close(1); + close(2); + + _exit(0376); /* This is what t2open does */ + } + else { /* No fork happened */ + EliError(st, ELI_ERR_SYSERROR, (EliSexp_t *) 0, "ELI-PRIMITIVE [FILTER (couldn't fork)]", errno); + close(stdinpipe[0]); + close(stdinpipe[1]); + close(stdoutpipe[0]); + close(stdoutpipe[1]); + free(childcmdargs); + return; + } + } + } *** overhead/eli/lib/prims2.c Tue Feb 27 15:45:01 1990 --- overhead/eli/lib/prims2.c.NEW Wed Feb 14 16:54:02 1990 *************** *** 0 **** --- 1,1979 ---- + /* ********************************************************************** *\ + * Copyright IBM Corporation 1988,1989 - All Rights Reserved * + * For full copyright information see:'andrew/config/COPYRITE' * + \* ********************************************************************** */ + + /* + * $Header: /afs/andrew.cmu.edu/itc/src/andrew/overhead/eli/lib/RCS/prims2.c,v 1.1 90/02/13 15:23:46 bobg Exp $ + * + * $Source: /afs/andrew.cmu.edu/itc/src/andrew/overhead/eli/lib/RCS/prims2.c,v $ + */ + + #include + #include + + void Prim_SETQ(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *argptr1, *argptr2, *tmp, *tmperr, *tmp2; + EliSym_t *symtmp, *symtmp2; + + EliDebug(20, "Entering primitive SETQ", st, FALSE); + if (2 != EliListLen(arglist)) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [SETQ (checking arglist size)]", 0); + return; + } + argptr1 = EliCons_GetCar(arglist); + if (EliSexp_GetType(argptr1) != e_data_symbol) { + EliError(st, ELI_ERR_BAD_ARGS, argptr1, "ELI-PRIMITIVE [SETQ (1st arg not a symbol)]", 0); + return; + } + symtmp = EliSexp_GetSym(argptr1); + tmp = EliCons_GetCdr(arglist); + if (!(argptr2 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, EliCons_GetCar(EliSexp_GetCons(tmp)), argptr2); + if (EliErr_ErrP(st)) + return; + if (symtmp2 = EliEvalStk_FindSym(st, EliStr_GetString(EliSym_GetName(symtmp)))) { + EliSym_BindSexp(st, symtmp2, argptr2); + EliSexp_SetSexp(st, resbuf, argptr2); + } + else { + EliSym_BindSexp(st, symtmp, argptr2); + if (eliSym_GetScope(symtmp) == e_sym_known) { + if (!(tmp2 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliSym_SetScope(symtmp, e_sym_global); + EliSexp_SetSym(st, tmp2, symtmp); + eliHT_Insert(st, EliSymbolTable(st), tmp2, EliStr_GetString(EliSym_GetName(symtmp))); + eliHT_Delete(st, EliTempSymTable(st), EliStr_GetString(EliSym_GetName(symtmp))); + } + switch (EliSexp_GetType(argptr2)) { + case e_data_integer: + EliSexp_SetInt(st, resbuf, EliSexp_GetInt(argptr2)); + break; + case e_data_string: + EliSexp_SetStr(st, resbuf, EliSexp_GetStr(argptr2)); + break; + case e_data_symbol: + EliSexp_SetSym(st, resbuf, EliSexp_GetSym(argptr2)); + break; + case e_data_list: + EliSexp_SetCons(st, resbuf, EliSexp_GetCons(argptr2)); + break; + case e_data_fn: + EliSexp_SetFn(st, resbuf, EliSexp_GetFn(argptr2)); + break; + } + } + } + + + /* Here is the definition for "Prim_PLUS", used above */ + + void Prim_PLUS(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliCons_t *argptr = arglist; + EliSexp_t *curarg, *evalarg, *tmp, *tmperr; + int args = EliListLen(arglist), i; + long result = 0L; + + EliDebug(20, "Entering primitive PLUS", st, FALSE); + if (!args) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [PLUS (checking arglist size)]", 0); + return; + } + for (i = 0; i < args; ++i) { + curarg = EliCons_GetCar(argptr); + if (!(evalarg = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, curarg, evalarg); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(evalarg) != e_data_integer) { + EliError(st, ELI_ERR_BAD_ARGS, evalarg, "ELI-PRIMITIVE [PLUS (an arg is not an int)]", 0); + return; + } + result += EliSexp_GetInt(evalarg); + if (i < args - 1) { + tmp = EliCons_GetCdr(argptr); + argptr = EliSexp_GetCons(tmp); + } + } + EliSexp_SetInt(st, resbuf, result); + } + + void Prim_DEFUN(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *namearg, *argsarg, *bodyarg, *nodetmp, *node[2], *tmperr, *tmp2; + EliCons_t *tmp, *cell[3]; + EliSym_t *symtmp; + EliFn_t *fn; + int i; + + EliDebug(20, "Entering primitive DEFUN", st, FALSE); + if (3 != EliListLen(arglist)) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [DEFUN (checking arglist size)]", 0); + return; + } + namearg = EliCons_GetCar(arglist); + nodetmp = EliCons_GetCdr(arglist); + argsarg = EliCons_GetCar(tmp = EliSexp_GetCons(nodetmp)); + nodetmp = EliCons_GetCdr(tmp); + bodyarg = EliCons_GetCar(EliSexp_GetCons(nodetmp)); + if (EliSexp_GetType(namearg) != e_data_symbol) { + EliError(st, ELI_ERR_BAD_ARGS, namearg, "ELI-PRIMITIVE [DEFUN (1st arg not a symbol)]", 0); + return; + } + if ((EliSexp_GetType(argsarg) != e_data_list) && !EliNilP(st, argsarg)) { + EliError(st, ELI_ERR_BAD_ARGS, argsarg, "ELI-PRIMITIVE [DEFUN (2nd arg not a list)]", 0); + return; + } + for (i = 0; i < 3; ++i) { + if (!(cell[i] = eliCons_GetNew_trace(st, EliTraceStk(st)))) + return; + if (i > 0) { + if (!(node[i - 1] = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, node[i - 1], cell[i]); + EliCons_BindCdr(st, cell[i - 1], node[i - 1]); + } + } + if (!(nodetmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetSym(st, nodetmp, EliLambdaSym(st)); + EliCons_BindCar(st, cell[0], nodetmp); + EliCons_BindCar(st, cell[1], argsarg); + EliCons_BindCar(st, cell[2], bodyarg); + if (!(fn = eliFn_GetNew_trace(st, EliTraceStk(st)))) + return; + eliFn_SetCons(st, fn, cell[0]); + symtmp = EliSexp_GetSym(namearg); + if (EliErr_ErrP(st)) + return; + EliSym_BindFn(st, symtmp, fn); + if (eliSym_GetScope(symtmp) == e_sym_known) { + if (!(tmp2 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliSym_SetScope(symtmp, e_sym_global); + EliSexp_SetSym(st, tmp2, symtmp); + eliHT_Insert(st, EliSymbolTable(st), tmp2, EliStr_GetString(EliSym_GetName(symtmp))); + eliHT_Delete(st, EliTempSymTable(st), EliStr_GetString(EliSym_GetName(symtmp))); + } + EliSexp_SetSym(st, resbuf, symtmp); + } + + void Prim_DEFUNQ(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *namearg, *argsarg, *bodyarg, *nodetmp, *node[2], *tmperr, *tmp2; + EliCons_t *tmp, *cell[3]; + EliSym_t *symtmp; + EliFn_t *fn; + int i; + + EliDebug(20, "Entering primitive DEFUNQ", st, FALSE); + if (3 != EliListLen(arglist)) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [DEFUNQ (checking arglist size)]", 0); + return; + } + namearg = EliCons_GetCar(arglist); + nodetmp = EliCons_GetCdr(arglist); + argsarg = EliCons_GetCar(tmp = EliSexp_GetCons(nodetmp)); + nodetmp = EliCons_GetCdr(tmp); + bodyarg = EliCons_GetCar(EliSexp_GetCons(nodetmp)); + if (EliSexp_GetType(namearg) != e_data_symbol) { + EliError(st, ELI_ERR_BAD_ARGS, namearg, "ELI-PRIMITIVE [DEFUNQ (1st arg not a symbol)]", 0); + return; + } + if ((EliSexp_GetType(argsarg) != e_data_list) && !EliNilP(st, argsarg)) { + EliError(st, ELI_ERR_BAD_ARGS, argsarg, "ELI-PRIMITIVE [DEFUNQ (2nd arg not a list)]", 0); + return; + } + for (i = 0; i < 3; ++i) { + if (!(cell[i] = eliCons_GetNew_trace(st, EliTraceStk(st)))) + return; + if (i > 0) { + if (!(node[i - 1] = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, node[i - 1], cell[i]); + EliCons_BindCdr(st, cell[i - 1], node[i - 1]); + } + } + if (!(nodetmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetSym(st, nodetmp, EliLambdaqSym(st)); + EliCons_BindCar(st, cell[0], nodetmp); + EliCons_BindCar(st, cell[1], argsarg); + EliCons_BindCar(st, cell[2], bodyarg); + if (!(fn = eliFn_GetNew_trace(st, EliTraceStk(st)))) + return; + eliFn_SetCons(st, fn, cell[0]); + symtmp = EliSexp_GetSym(namearg); + if (EliErr_ErrP(st)) + return; + EliSym_BindFn(st, symtmp, fn); + if (eliSym_GetScope(symtmp) == e_sym_known) { + if (!(tmp2 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliSym_SetScope(symtmp, e_sym_global); + EliSexp_SetSym(st, tmp2, symtmp); + eliHT_Insert(st, EliSymbolTable(st), tmp2, EliStr_GetString(EliSym_GetName(symtmp))); + eliHT_Delete(st, EliTempSymTable(st), EliStr_GetString(EliSym_GetName(symtmp))); + } + eliSym_SetScope(symtmp, e_sym_global); + EliSexp_SetSym(st, resbuf, symtmp); + } + + void Prim_CONS(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *arg1, *arg2, *evalarg1, *evalarg2, *nodetmp, *tmperr; + EliCons_t *tmp; + + EliDebug(20, "Entering primitive CONS", st, FALSE); + if (2 != EliListLen(arglist)) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [CONS (checking arglist size)]", 0); + return; + } + arg1 = EliCons_GetCar(arglist); + nodetmp = EliCons_GetCdr(arglist); + arg2 = EliCons_GetCar(EliSexp_GetCons(nodetmp)); + if (!(evalarg1 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + if (!(evalarg2 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, arg1, evalarg1); + if (EliErr_ErrP(st)) + return; + eliEval(st, arg2, evalarg2); + if (EliErr_ErrP(st)) + return; + if ((EliSexp_GetType(evalarg2) != e_data_list) && !EliNilP(st, evalarg2)) { + EliError(st, ELI_ERR_BAD_ARGS, evalarg2, "ELI-PRIMITIVE [CONS (2nd arg not a list)]", 0); + return; + } + if (!(tmp = eliCons_GetNew_trace(st, EliTraceStk(st)))) + return; + EliCons_BindCar(st, tmp, evalarg1); + if (!EliNilP(st, evalarg2)) + EliCons_BindCdr(st, tmp, evalarg2); + EliSexp_SetCons(st, resbuf, tmp); + } + + + /* + * Definition of PROGN, which evaluates each of its arbitrarily-many + * arguments in turn, and returns the value of the last one evaluated + */ + + void Prim_PROGN(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *tmp, *evaltmp; + EliCons_t *argptr = arglist; + int i, len = EliListLen(arglist); + + EliDebug(20, "Entering primitive PROGN", st, FALSE); + for (i = 0; i < len - 1; ++i) { + if (!(evaltmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, EliCons_GetCar(argptr), evaltmp); + if (EliErr_ErrP(st)) + return; + tmp = EliCons_GetCdr(argptr); + argptr = EliSexp_GetCons(tmp); + } + eliEval(st, EliCons_GetCar(argptr), resbuf); + if (EliErr_ErrP(st)) + return; /* Of course, you realize how + * ridiculous this is */ + } + + /* You know what this one does */ + + void Prim_EVAL(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *tmp, *tmperr; + + EliDebug(20, "Entering primitive EVAL", st, FALSE); + if (EliListLen(arglist) != 1) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [EVAL (checking arglist size)]", 0); + return; + } + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, EliCons_GetCar(arglist), tmp); + if (EliErr_ErrP(st)) + return; + eliEval(st, tmp, resbuf); + if (EliErr_ErrP(st)) + return; + } + + + void Prim_CAR(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *tmp, *tmp2, *tmperr; + + EliDebug(20, "Entering primitive CAR", st, FALSE); + if (EliListLen(arglist) != 1) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [CAR (checking arglist size)]", 0); + return; + } + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, EliCons_GetCar(arglist), tmp); + if (EliErr_ErrP(st)) + return; + if ((EliSexp_GetType(tmp) != e_data_list) && !EliNilP(st, tmp)) { + EliError(st, ELI_ERR_BAD_ARGS, tmp, "ELI-PRIMITIVE [CAR (arg not a list)]", 0); + return; + } + if (EliSexp_GetType(tmp) == e_data_list) { + tmp2 = EliCons_GetCar(EliSexp_GetCons(tmp)); + switch (EliSexp_GetType(tmp2)) { + case e_data_integer: + EliSexp_SetInt(st, resbuf, EliSexp_GetInt(tmp2)); + break; + case e_data_symbol: + EliSexp_SetSym(st, resbuf, EliSexp_GetSym(tmp2)); + break; + case e_data_string: + EliSexp_SetStr(st, resbuf, EliSexp_GetStr(tmp2)); + break; + case e_data_list: + EliSexp_SetCons(st, resbuf, EliSexp_GetCons(tmp2)); + break; + case e_data_fn: + EliSexp_SetFn(st, resbuf, EliSexp_GetFn(tmp2)); + break; + case e_data_none: + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + break; + } + } + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + + void Prim_CDR(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *tmp, *tmp2, *tmperr; + + EliDebug(20, "Entering primitive CDR", st, FALSE); + if (EliListLen(arglist) != 1) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [CDR (checking arglist size)]", 0); + return; + } + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, EliCons_GetCar(arglist), tmp); + if (EliErr_ErrP(st)) + return; + if ((EliSexp_GetType(tmp) != e_data_list) && !EliNilP(st, tmp)) { + EliError(st, ELI_ERR_BAD_ARGS, tmp, "ELI-PRIMITIVE [CDR (arg not a list)]", 0); + return; + } + if (EliSexp_GetType(tmp) == e_data_list) { + tmp2 = EliCons_GetCdr(EliSexp_GetCons(tmp)); + switch (EliSexp_GetType(tmp2)) { + case e_data_integer: + EliSexp_SetInt(st, resbuf, EliSexp_GetInt(tmp2)); + break; + case e_data_symbol: + EliSexp_SetSym(st, resbuf, EliSexp_GetSym(tmp2)); + break; + case e_data_string: + EliSexp_SetStr(st, resbuf, EliSexp_GetStr(tmp2)); + break; + case e_data_list: + EliSexp_SetCons(st, resbuf, EliSexp_GetCons(tmp2)); + break; + case e_data_fn: + EliSexp_SetFn(st, resbuf, EliSexp_GetFn(tmp2)); + break; + case e_data_none: + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + break; + } + } + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + + + /* Creates a list from its arbitrarily-many arguments */ + + void Prim_LIST(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *tmp, *tmp2; + EliCons_t *argptr = arglist, *prevcell, *curcell, *result; + int len = EliListLen(arglist), i, resultlen = 0; + + EliDebug(20, "Entering primitive LIST", st, FALSE); + if (!(prevcell = result = eliCons_GetNew_trace(st, EliTraceStk(st)))) + return; + for (i = 0; i < len; ++i) { + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, EliCons_GetCar(argptr), tmp); + if (EliErr_ErrP(st)) + return; + if (!(resultlen++)) + EliCons_BindCar(st, result, tmp); + else { + if (!(curcell = eliCons_GetNew_trace(st, EliTraceStk(st)))) + return; + EliCons_BindCar(st, curcell, tmp); + if (!(tmp2 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmp2, curcell); + EliCons_BindCdr(st, prevcell, tmp2); + prevcell = curcell; + } + if (i < len - 1) { + tmp = EliCons_GetCdr(argptr); + argptr = EliSexp_GetCons(tmp); + } + } + EliSexp_SetCons(st, resbuf, result); + } + + void Prim_COND(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + int i, len = EliListLen(arglist), untrue = TRUE; + EliCons_t *argptr = arglist; + EliSexp_t *tmp, *tmp2, *testnode, *actnode; + + EliDebug(20, "Entering primitive COND", st, FALSE); + EliSexp_SetSym(st, resbuf, EliNilSym(st)); /* Default if no case gets + * EliEval'd */ + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + for (i = 0; (i < len) && untrue; ++i) { + testnode = EliCons_GetCar(argptr); + if (EliSexp_GetType(testnode) != e_data_list) { + EliError(st, ELI_ERR_BAD_ARGS, testnode, "ELI-PRIMITIVE [COND (an arg is not a list)]", 0); + return; + } + if (2 != EliListLen(EliSexp_GetCons(testnode))) { + EliError(st, ELI_ERR_BAD_ARGS, testnode, "ELI-PRIMITIVE [COND (an arg is not a 2-element list)]", 0); + return; + } + eliEval(st, EliCons_GetCar(EliSexp_GetCons(testnode)), tmp); + if (EliErr_ErrP(st)) + return; + if (!EliNilP(st, tmp)) { + untrue = FALSE; + actnode = EliCons_GetCdr(EliSexp_GetCons(testnode)); + eliEval(st, EliCons_GetCar(EliSexp_GetCons(actnode)), resbuf); + if (EliErr_ErrP(st)) + return; + } + else { + if (i < len - 1) { + tmp2 = EliCons_GetCdr(argptr); + argptr = EliSexp_GetCons(tmp2); + } + } + } + } + + void Prim_PRINT(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *tmp; + + EliDebug(20, "Entering primitive PRINT", st, FALSE); + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, EliCons_GetCar(arglist), tmp); + if (EliErr_ErrP(st)) + return; + switch (EliSexp_GetType(tmp)) { + case e_data_integer: + EliSexp_SetInt(st, resbuf, EliSexp_GetInt(tmp)); + break; + case e_data_string: + EliSexp_SetStr(st, resbuf, EliSexp_GetStr(tmp)); + break; + case e_data_symbol: + EliSexp_SetSym(st, resbuf, EliSexp_GetSym(tmp)); + break; + case e_data_list: + EliSexp_SetCons(st, resbuf, EliSexp_GetCons(tmp)); + break; + case e_data_fn: + EliSexp_SetFn(st, resbuf, EliSexp_GetFn(tmp)); + break; + } + EliDisplaySexp(tmp); + } + + void Prim_TERPRI(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliDebug(20, "Entering primitive TERPRI", st, FALSE); + EliSexp_SetSym(st, resbuf, EliTSym(st)); /* Always return true */ + putchar('\n'); + } + + void Prim_EQ(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *tmperr, *tmpnode, *node1, *node2, *evalnode1, *evalnode2; + + EliDebug(20, "Entering primitive EQ", st, FALSE); + if (EliListLen(arglist) != 2) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [EQ (checking arglist size)]", 0); + return; + } + node1 = EliCons_GetCar(arglist); + tmpnode = EliCons_GetCdr(arglist); + node2 = EliCons_GetCar(EliSexp_GetCons(tmpnode)); + if (!(evalnode1 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, node1, evalnode1); + if (EliErr_ErrP(st)) + return; + if (!(evalnode2 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, node2, evalnode2); + if (EliErr_ErrP(st)) + return; + if (EliSexpEq(evalnode1, evalnode2)) + EliSexp_SetSym(st, resbuf, EliTSym(st)); + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + + void Prim_STRCONTAINS(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *err, *evalNode, *args[3]; + char *str1, *str2; + int ignoreCase = FALSE, numArgs; + + EliDebug(20, "Entering primitive STRCONTAINS", st, FALSE); + if ((numArgs = EliGetListCars(arglist, args, 3)) < 2) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [STRCONTAINS (checking arglist size)]", 0); + return; + } + if (!(evalNode = EliEval(st, args[0]))) + return; + if (EliSexp_GetType(evalNode) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, evalNode, "ELI-PRIMITIVE [STRCONTAINS (1st arg not a string)]", 0); + return; + } + str1 = EliStr_GetString(EliSexp_GetStr(evalNode)); + + if (!(evalNode = EliEval(st, args[1]))) + return; + if (EliSexp_GetType(evalNode) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, evalNode, "ELI-PRIMITIVE [STRCONTAINS (2nd arg not a string)]", 0); + return; + } + str2 = EliStr_GetString(EliSexp_GetStr(evalNode)); + + if (numArgs == 3) { + if (!(evalNode = EliEval(st, args[2]))) + return; + ignoreCase = !EliNilP(st, evalNode); + } + + if (eliFindPrefix(str1, str2, ignoreCase)) + EliSexp_SetSym(st, resbuf, EliTSym(st)); + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + + void Prim_ASSOC(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *tmperr, *tmpnode, *node1, *node2, *evalnode1, *evalnode2; + int found, i, len; + EliCons_t *consptr, *assoclist; + + EliDebug(20, "Entering primitive ASSOC", st, FALSE); + EliSexp_SetSym(st, resbuf, EliNilSym(st)); /* Default */ + if (EliListLen(arglist) != 2) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [ASSOC (checking arglist size)]", 0); + return; + } + node1 = EliCons_GetCar(arglist); + tmpnode = EliCons_GetCdr(arglist); + node2 = EliCons_GetCar(EliSexp_GetCons(tmpnode)); + if (!(evalnode1 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, node1, evalnode1); + if (EliErr_ErrP(st)) + return; + if (!(evalnode2 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, node2, evalnode2); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(evalnode2) != e_data_list) { + EliError(st, ELI_ERR_BAD_ARGS, evalnode2, "ELI-PRIMITIVE [ASSOC (2nd arg not a list)]", 0); + return; + } + + /* + * Now we have some node evalnode1, and a list evalnode2. What are you + * gonna do about it? + */ + + consptr = assoclist = EliSexp_GetCons(evalnode2); + len = EliListLen(assoclist); + found = FALSE; + for (i = 0; (i < len - 1) && !found; ++i) { + tmpnode = EliCons_GetCar(consptr); + if (EliSexp_GetType(tmpnode) == e_data_list) + if (EliSexpEqual(st, evalnode1, EliCons_GetCar(EliSexp_GetCons(tmpnode)))) + found = TRUE; + if (!found) { + tmpnode = EliCons_GetCdr(consptr); + consptr = EliSexp_GetCons(tmpnode); + } + } + if (!found) { + tmpnode = EliCons_GetCar(consptr); + if (EliSexp_GetType(tmpnode) == e_data_list) + if (EliSexpEqual(st, evalnode1, EliCons_GetCar(EliSexp_GetCons(tmpnode)))) + found = TRUE; + } + if (found) + EliSexp_SetCons(st, resbuf, EliSexp_GetCons(tmpnode)); + } + + void Prim_STRSTARTS(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *tmperr, *tmpnode, *node1, *node2, *evalnode1, *evalnode2; + char *str1, *str2; + int len; + + EliDebug(20, "Entering primitive STRSTARTS", st, FALSE); + if (EliListLen(arglist) != 2) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [STRSTARTS (checking arglist size)]", 0); + return; + } + node1 = EliCons_GetCar(arglist); + tmpnode = EliCons_GetCdr(arglist); + node2 = EliCons_GetCar(EliSexp_GetCons(tmpnode)); + if (!(evalnode1 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, node1, evalnode1); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(evalnode1) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, evalnode1, "ELI-PRIMITIVE [STRSTARTS (1st arg not a string)]", 0); + return; + } + if (!(evalnode2 = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, node2, evalnode2); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(evalnode2) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, evalnode2, "ELI-PRIMITIVE [STRSTARTS (2nd arg not a string)]", 0); + return; + } + + /* + * Now we have evalnode1 and evalnode2 both pointing to strnodes. Is + * evalnode1 the start of evalnode2? + */ + + str1 = EliStr_GetString(EliSexp_GetStr(evalnode1)); + str2 = EliStr_GetString(EliSexp_GetStr(evalnode2)); + len = strlen(str1); + if (strncmp(str1, str2, len)) + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + else + EliSexp_SetSym(st, resbuf, EliTSym(st)); + } + + void Prim_LETSTAR(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliCons_t *bindings, *bindingsptr, *bindval, *thisbinding, *constmp; + EliSexp_t *nodetmp, *expr, *evalresult, *tmperr; + EliSym_t *varname, *thevar; + int numbindings, i, numargs; + + EliDebug(20, "Entering primitive LET*", st, FALSE); + numargs = EliListLen(arglist); + if ((numargs < 1) || (numargs > 2)) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [LET* (checking arglist size)]", 0); + return; + } + nodetmp = EliCons_GetCar(arglist); + if (EliSexp_GetType(nodetmp) != e_data_list) { + EliError(st, ELI_ERR_BAD_ARGS, nodetmp, "ELI-PRIMITIVE [LET* (1st arg not a list)]", 0); + return; + } + bindingsptr = bindings = EliSexp_GetCons(nodetmp); + numbindings = EliListLen(bindings); + for (i = 0; i < numbindings; ++i) { + nodetmp = EliCons_GetCar(bindingsptr); + if (EliSexp_GetType(nodetmp) != e_data_list) { + EliError(st, ELI_ERR_BAD_ARGS, nodetmp, "ELI-PRIMITIVE [LET* (1st arg contains a non-list member)]", 0); + eliEvalStk_PopN(st, EliEvalStack(st), i); + return; + } + thisbinding = EliSexp_GetCons(nodetmp); + if (EliListLen(thisbinding) != 2) { + EliError(st, ELI_ERR_BAD_ARGS, nodetmp, "ELI-PRIMITIVE [LET* (1st arg contains a non-2-element list)]", 0); + eliEvalStk_PopN(st, EliEvalStack(st), i); + return; + } + nodetmp = EliCons_GetCar(thisbinding); + if (EliSexp_GetType(nodetmp) != e_data_symbol) { + EliError(st, ELI_ERR_BAD_ARGS, nodetmp, "ELI-PRIMITIVE [LET* (1st arg contains a binding to a non-symbol)]", 0); + eliEvalStk_PopN(st, EliEvalStack(st), i); + return; + } + varname = EliSexp_GetSym(nodetmp); + if (!(thevar = eliSym_GetNew_trace(st, EliTraceStk(st), EliSym_GetName(varname)))) { + eliEvalStk_PopN(st, EliEvalStack(st), i); + return; + } + nodetmp = EliCons_GetCdr(thisbinding); + bindval = EliSexp_GetCons(nodetmp); + nodetmp = EliCons_GetCar(bindval); + if (!(evalresult = eliSexp_GetNew_trace(st, EliTraceStk(st)))) { + eliEvalStk_PopN(st, EliEvalStack(st), i); + return; + } + eliEval(st, nodetmp, evalresult); + if (EliErr_ErrP(st)) { + eliEvalStk_PopN(st, EliEvalStack(st), i); + return; + } + EliSym_BindSexp(st, thevar, evalresult); + if (!eliEvalStk_Push(st, EliEvalStack(st), thevar)) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [LET* (pushing symbol)]", 0); + eliEvalStk_PopN(st, EliEvalStack(st), i); + return; + } + if (i < numbindings - 1) { + nodetmp = EliCons_GetCdr(bindingsptr); + bindingsptr = EliSexp_GetCons(nodetmp); + } + } + if (numargs == 2) { /* If there's a body to evaluate... */ + nodetmp = EliCons_GetCdr(arglist); + constmp = EliSexp_GetCons(nodetmp); + expr = EliCons_GetCar(constmp); + eliEval(st, expr, resbuf); /* No need to check errp here, since + * nothing different would happen in + * handling the error anyway */ + } + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + eliEvalStk_PopN(st, EliEvalStack(st), numbindings); + } + + void Prim_AND(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + int len = EliListLen(arglist), i; + EliSexp_t *restmp, *tmp; + EliCons_t *constmp = arglist; + + EliDebug(20, "Entering primitive AND", st, FALSE); + if (!(restmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + for (i = 0; i < len; ++i) { + tmp = EliCons_GetCar(constmp); + eliEval(st, tmp, restmp); + if (EliErr_ErrP(st)) + return; + if (EliNilP(st, restmp)) + i = len; + if (i < len - 1) { + tmp = EliCons_GetCdr(constmp); + constmp = EliSexp_GetCons(tmp); + } + } + EliSexp_SetSexp(st, resbuf, restmp); + } + + void Prim_OR(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + int len = EliListLen(arglist), i; + EliSexp_t *restmp, *tmp; + EliCons_t *constmp = arglist; + + EliDebug(20, "Entering primitive OR", st, FALSE); + if (!(restmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + for (i = 0; i < len; ++i) { + tmp = EliCons_GetCar(constmp); + eliEval(st, tmp, restmp); + if (EliErr_ErrP(st)) + return; + if (!EliNilP(st, restmp)) + i = len; + if (i < len - 1) { + tmp = EliCons_GetCdr(constmp); + constmp = EliSexp_GetCons(tmp); + } + } + EliSexp_SetSexp(st, resbuf, restmp); + } + + void Prim_NOT(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *tmperr, *tmp, *restmp; + + EliDebug(20, "Entering primitive NOT", st, FALSE); + if (1 != EliListLen(arglist)) { + if (!(tmperr = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, tmperr, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, tmperr, "ELI-PRIMITIVE [NOT (checking arglist size)]", 0); + } + if (!(restmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + tmp = EliCons_GetCar(arglist); + eliEval(st, tmp, restmp); + if (EliErr_ErrP(st)) + return; + EliSexp_SetSym(st, resbuf, EliNilP(st, restmp) ? EliTSym(st) : EliNilSym(st)); + } + + void Prim_RE_STRDECOMPOSEPLUS(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[3], *err, *patNode, *refNode, *strs[3], *cdrs[2], *aNode; + int numargs, rxpResult, i; + char *pat, *ref, tempChar, *hold; + EliStr_t *strNodes[3], *aStr; + EliCons_t *consCells[3], *subListHead, *subListPtr, *aCell; + regexp *rptr, *regcomp(); + + EliDebug(20, "Entering primitive RE-STRDECOMPOSE+", st, FALSE); + numargs = EliGetListCars(arglist, args, 2); + if (numargs < 2) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [RE-STRDECOMPOSE+ (checking arglist size)]", 0); + return; + } + if (!(patNode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[0], patNode); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(patNode) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, patNode, "ELI-PRIMITIVE [RE-STRDECOMPOSE+ (1st arg not a string)]", 0); + return; + } + pat = EliStr_GetString(EliSexp_GetStr(patNode)); + if (!(refNode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + eliEval(st, args[1], refNode); + if (EliErr_ErrP(st)) + return; + if (EliSexp_GetType(refNode) != e_data_string) { + EliError(st, ELI_ERR_BAD_ARGS, refNode, "ELI-PRIMITIVE [RE-STRDECOMPOSE+ (2nd arg not a string)]", 0); + return; + } + ref = EliStr_GetString(EliSexp_GetStr(refNode)); + if (!(rptr = regcomp(pat))) { + EliError(st, ELI_ERR_BAD_ARGS, patNode, "ELI-PRIMITIVE [RE-STRDECOMPOSE+ (compiling regular expression)]", 0); + return; + } + rxpResult = regexec(rptr, ref); + if (rxpResult) { + tempChar = *(rptr->startp[0]); + *(rptr->startp[0]) = '\0'; + if (!(hold = EliSaveString(ref))) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [RE-STRDECOMPOSE+ (allocating space for 1st result string)]", 0); + free(rptr); + return; + } + *(rptr->startp[0]) = tempChar; + strNodes[0] = eliStringTable_FindOrMake(st, EliStringTable(st), hold); + free(hold); + if (!(strNodes[0])) { + free(rptr); + return; + } + tempChar = *(rptr->endp[0]); + *(rptr->endp[0]) = '\0'; + if (!(hold = EliSaveString(rptr->startp[0]))) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [RE-STRDECOMPOSE+ (allocating space for 2nd result string)]", 0); + free(rptr); + return; + } + *(rptr->endp[0]) = tempChar; + strNodes[1] = eliStringTable_FindOrMake(st, EliStringTable(st), hold); + free(hold); + if (!(strNodes[1])) { + free(rptr); + return; + } + if (!(strNodes[2] = eliStringTable_FindOrMake(st, EliStringTable(st), rptr->endp[0]))) { + free(rptr); + return; + } + + if (!(subListPtr = subListHead = eliCons_GetNew_trace(st, EliTraceStk(st)))) { + free(rptr); + return; + } + if (!(aNode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) { + free(rptr); + return; + } + EliSexp_SetStr(st, aNode, strNodes[1]); + EliCons_BindCar(st, subListHead, aNode); + for (i = 1; (i < 10) && rptr->startp[i]; ++i) { + if (!(aCell = eliCons_GetNew_trace(st, EliTraceStk(st)))) { + free(rptr); + return; + } + if (!(aNode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) { + free(rptr); + return; + } + EliSexp_SetCons(st, aNode, aCell); + EliCons_BindCdr(st, subListPtr, aNode); + subListPtr = aCell; + tempChar = *(rptr->endp[i]); + *(rptr->endp[i]) = '\0'; + if (!(hold = EliSaveString(rptr->startp[i]))) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [RE-STRDECOMPOSE+ (allocating space for a submatch)]", 0); + free(rptr); + return; + } + *(rptr->endp[i]) = tempChar; + aStr = eliStringTable_FindOrMake(st, EliStringTable(st), hold); + free(hold); + if (!aStr) { + free(rptr); + return; + } + if (!(aNode = eliSexp_GetNew_trace(st, EliTraceStk(st)))) { + free(rptr); + return; + } + EliSexp_SetStr(st, aNode, aStr); + EliCons_BindCar(st, aCell, aNode); + } + free(rptr); + + if ((!(strs[0] = eliSexp_GetNew_trace(st, EliTraceStk(st)))) || (!(strs[1] = eliSexp_GetNew_trace(st, EliTraceStk(st)))) || (!(strs[2] = eliSexp_GetNew_trace(st, EliTraceStk(st))))) + return; + + EliSexp_SetStr(st, strs[0], strNodes[0]); + EliSexp_SetCons(st, strs[1], subListHead); + EliSexp_SetStr(st, strs[2], strNodes[2]); + + if ((!(consCells[0] = eliCons_GetNew_trace(st, EliTraceStk(st)))) || (!(consCells[1] = eliCons_GetNew_trace(st, EliTraceStk(st)))) || (!(consCells[2] = eliCons_GetNew_trace(st, EliTraceStk(st))))) + return; + + if ((!(cdrs[0] = eliSexp_GetNew_trace(st, EliTraceStk(st)))) || (!(cdrs[1] = eliSexp_GetNew_trace(st, EliTraceStk(st))))) + return; + + EliSexp_SetCons(st, cdrs[0], consCells[1]); + EliSexp_SetCons(st, cdrs[1], consCells[2]); + EliCons_BindCar(st, consCells[0], strs[0]); + EliCons_BindCdr(st, consCells[0], cdrs[0]); + EliCons_BindCar(st, consCells[1], strs[1]); + EliCons_BindCdr(st, consCells[1], cdrs[1]); + EliCons_BindCar(st, consCells[2], strs[2]); + EliSexp_SetCons(st, resbuf, consCells[0]); + } + else { + free(rptr); + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + } + + void Prim_LET(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *err = NULL, *tmp, *args[2], *bindingDudes[2]; + EliCons_t *varList = NULL, *valList = NULL, *bindingsList, *bindingsPtr, *thisBinding, *evalVals; + int numBindings, i, bound, numargs; + EliSym_t *sym; + + EliDebug(20, "Entering primitive LET", st, FALSE); + if ((numargs = EliGetListCars(arglist, args, 2)) < 1) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [LET (checking arglist size)]", 0); + return; + } + if (EliSexp_GetType(args[0]) != e_data_list) { + EliError(st, ELI_ERR_BAD_ARGS, args[0], "ELI-PRIMITIVE [LET (1st arg not a list)]", 0); + return; + } + bindingsPtr = bindingsList = EliSexp_GetCons(args[0]); + if (!(numBindings = EliListLen(bindingsList))) { + EliError(st, ELI_ERR_BAD_ARGS, args[0], "ELI-PRIMITIVE [LET (1st arg empty)]", 0); + return; + } + for (i = 0; i < numBindings; ++i) { + if (EliSexp_GetType(tmp = EliCons_GetCar(bindingsPtr)) != e_data_list) { + EliError(st, ELI_ERR_BAD_ARGS, tmp, "ELI-PRIMITIVE [LET (non-list in bindings list)]", 0); + return; + } + thisBinding = EliSexp_GetCons(tmp); + if (EliGetListCars(thisBinding, bindingDudes, 2) != 2) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, thisBinding); + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [LET (a binding in bindings list does not have 2 elements)]", 0); + return; + } + if (EliSexp_GetType(bindingDudes[0]) != e_data_symbol) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [LET (bindings list contains a binding to a non-symbol)]", 0); + return; + } + if (!(sym = eliSym_GetNew_trace(st, EliTraceStk(st), EliSym_GetName(EliSexp_GetSym(bindingDudes[0]))))) + return; + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetSym(st, tmp, sym); + if (!(varList = EliAddToList(st, varList, tmp))) + return; + if (!(valList = EliAddToList(st, valList, bindingDudes[1]))) + return; + bindingsPtr = EliGetNextCell(bindingsPtr); + } + + /* + * Now varList contains the var names, and valList contains the values. + * Let's EliEval the values into a new list, then eliBind the results. + */ + + if (!(evalVals = EliEvalListToList(st, valList))) + return; + + bound = eliBind(st, EliEvalStack(st), varList, evalVals); + if (EliErr_ErrP(st)) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + + if (numargs == 2) + eliEval(st, args[1], resbuf); /* We don't check for error here since + * in handling one we wouldn't do + * anything different anyway */ + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + eliEvalStk_PopN(st, EliEvalStack(st), bound); + } + + void Prim_DO(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *err = NULL, *tmp, *args[3], *bindingDudes[3], *endTest, *returnVal, *tmp2; + EliCons_t *varList = NULL, *initList = NULL, *updateList = NULL, *bindingsList, *bindingsPtr, *thisBinding, *initVals, *endAndReturn, *updatePtr, *varPtr, *updateVals; + int numBindings, i, bound, numArgs, thisBindingLen, loopy = TRUE; + EliSym_t *sym; + + EliDebug(20, "Entering primitive DO", st, FALSE); + if ((numArgs = EliGetListCars(arglist, args, 3)) < 2) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [DO (checking arglist size)]", 0); + return; + } + if (EliSexp_GetType(args[0]) != e_data_list) { + EliError(st, ELI_ERR_BAD_ARGS, args[0], "ELI-PRIMITIVE [DO (1st arg not a list)]", 0); + return; + } + if (EliSexp_GetType(args[1]) != e_data_list) { + EliError(st, ELI_ERR_BAD_ARGS, args[1], "ELI-PRIMITIVE [DO (2nd arg not a list)]", 0); + return; + } + endAndReturn = EliSexp_GetCons(args[1]); + if (EliListLen(endAndReturn) != 2) { + EliError(st, ELI_ERR_BAD_ARGS, args[1], "ELI-PRIMITIVE [DO (2nd arg does not have 2 elements)]", 0); + return; + } + endTest = EliCons_GetCar(endAndReturn); + returnVal = EliCons_GetCar(EliSexp_GetCons(EliCons_GetCdr(endAndReturn))); + bindingsPtr = bindingsList = EliSexp_GetCons(args[0]); + if (!(numBindings = EliListLen(bindingsList))) { + EliError(st, ELI_ERR_BAD_ARGS, args[0], "ELI-PRIMITIVE [DO (1st arg empty)]", 0); + return; + } + for (i = 0; i < numBindings; ++i) { + if (EliSexp_GetType(tmp = EliCons_GetCar(bindingsPtr)) != e_data_list) { + EliError(st, ELI_ERR_BAD_ARGS, tmp, "ELI-PRIMITIVE [DO (non-list in bindings list)]", 0); + return; + } + thisBinding = EliSexp_GetCons(tmp); + if ((thisBindingLen = EliGetListCars(thisBinding, bindingDudes, 3)) < 2) { + if (!(err = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetCons(st, err, thisBinding); + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [DO (a binding in bindings list does not have 2 or 3 elements)]", 0); + return; + } + if (EliSexp_GetType(bindingDudes[0]) != e_data_symbol) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [DO (bindings list contains a binding to a non-symbol)]", 0); + return; + } + if (!(sym = eliSym_GetNew_trace(st, EliTraceStk(st), EliSym_GetName(EliSexp_GetSym(bindingDudes[0]))))) + return; + if (!(tmp = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSexp_SetSym(st, tmp, sym); + if (!(varList = EliAddToList(st, varList, tmp))) + return; + if (!(initList = EliAddToList(st, initList, bindingDudes[1]))) + return; + if (thisBindingLen < 3) + if (!(bindingDudes[2] = eliSexp_GetNew_trace(st, EliTraceStk(st)))) + return; + if (!(updateList = EliAddToList(st, updateList, bindingDudes[2]))) + return; + bindingsPtr = EliGetNextCell(bindingsPtr); + } + + if (!(initVals = EliEvalListToList(st, initList))) + return; + + bound = eliBind(st, EliEvalStack(st), varList, initVals); + if (EliErr_ErrP(st)) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + + while (loopy) { + if (!(tmp = EliEval(st, endTest))) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + if (EliNilP(st, tmp)) { + if (numArgs == 3) { + if (!(tmp = EliEval(st, args[2]))) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + } + updateVals = NULL; + updatePtr = updateList; + do { + tmp = EliCons_GetCar(updatePtr); + if (EliSexp_GetType(tmp) != e_data_none) { + if (!(tmp2 = EliEval(st, tmp))) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + if (!(updateVals = EliAddToList(st, updateVals, tmp2))) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + } + else + if (!(updateVals = EliAddToList(st, updateVals, tmp))) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + } while (updatePtr = EliGetNextCell(updatePtr)); + + updatePtr = updateVals; + varPtr = varList; + do { + tmp = EliCons_GetCar(updatePtr); + if (EliSexp_GetType(tmp) != e_data_none) { + sym = EliFindSym(st, EliStr_GetString(EliSym_GetName(EliSexp_GetSym(EliCons_GetCar(varPtr))))); + + /* + * I'm pretty sure this is the same sym node as is on the + * stack + */ + EliSym_BindSexp(st, sym, tmp); + } + varPtr = EliGetNextCell(varPtr); + } while (updatePtr = EliGetNextCell(updatePtr)); + } + else + loopy = FALSE; + } + eliEval(st, returnVal, resbuf); + if (EliErr_ErrP(st)) { + eliEvalStk_PopN(st, EliEvalStack(st), bound); + return; + } + eliEvalStk_PopN(st, EliEvalStack(st), bound); + } + + void Prim_SYM_TO_STR(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + eliDataTypes_t argV[1]; + EliSexp_t *args[1], *err; + int processResult, evalV[1]; + + EliDebug(20, "Entering primitive SYM-TO-STR", st, FALSE); + argV[0] = e_data_symbol; + evalV[0] = TRUE; + processResult = EliProcessList(st, arglist, 1, 1, args, &err, argV, evalV); + if ((processResult == -1) || (processResult == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [SYM-TO-STR (checking arglist size)]", 0); + return; + } + if (processResult == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [SYM-TO-STR (arg is not a symbol)]", 0); + return; + } + if (processResult < 0) + return; + EliSexp_SetStr(st, resbuf, EliSym_GetName(EliSexp_GetSym(args[0]))); + } + + void Prim_STR_TO_INT(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + long atol(); + eliDataTypes_t typeV[1]; + EliSexp_t *args[1], *err; + int processResult, evalV[1]; + + EliDebug(20, "Entering primitive STR-TO-INT", st, FALSE); + typeV[0] = e_data_string; + evalV[0] = TRUE; + processResult = EliProcessList(st, arglist, 1, 1, args, &err, typeV, evalV); + if ((processResult == -1) || (processResult == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [STR-TO-INT (checking arglist size)]", 0); + return; + } + if (processResult == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [STR-TO-INT (arg is not a string)]", 0); + return; + } + if (processResult < 0) + return; + EliSexp_SetInt(st, resbuf, atol(EliStr_GetString(EliSexp_GetStr(args[0])))); + } + + void Prim_INT_TO_STR(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + char buf[32]; /* Should be big enough for any int + * we'd want to print */ + eliDataTypes_t typeV[1]; + EliSexp_t *args[1], *err; + int processResult, evalV[1]; + EliStr_t *strNode; + + EliDebug(20, "Entering primitive INT-TO-STR", st, FALSE); + typeV[0] = e_data_integer; + evalV[0] = TRUE; + processResult = EliProcessList(st, arglist, 1, 1, args, &err, typeV, evalV); + if ((processResult == -1) || (processResult == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [INT-TO-STR (checking arglist size)]", 0); + return; + } + if (processResult == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [INT-TO-STR (arg is not an integer)]", 0); + return; + } + if (processResult < 0) + return; + sprintf(buf, "%ld", EliSexp_GetInt(args[0])); + if (!(strNode = eliStringTable_FindOrMake(st, EliStringTable(st), buf))) + return; + EliSexp_SetStr(st, resbuf, strNode); + } + + /* This one works like printf in C, but it's very primitive. + * Output goes to stdout, + * and the return value is T. Format controls are: + * %d for integers + * %s for strings (does NOT unparse the string) + * %S for any sexp (DOES unparse strings) + * %% outputs a % char. + * No modifiers or anything like that. + */ + + void Prim_PRINTF(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *thisArg, *err, *formatSexp; + EliCons_t *argPtr = arglist; + char *formatPtr, c; + int state = 0; /* 0 is normal, 1 is when we've just + * seen a % char */ + + EliDebug(20, "Entering primitive PRINTF", st, FALSE); + if (!(thisArg = EliEval(st, EliCons_GetCar(argPtr)))) + return; + if (e_data_string != EliSexp_GetType(thisArg)) { + EliError(st, ELI_ERR_BAD_ARGS, thisArg, "ELI-PRIMITIVE [PRINTF (1st arg not a string)]", 0); + return; + } + formatPtr = EliStr_GetString(EliSexp_GetStr(formatSexp = thisArg)); + argPtr = EliGetNextCell(argPtr); + while (c = *(formatPtr++)) { + if (state) { + state = 0; + switch (c) { + case 'd': + if (!argPtr) { + if (!(err = EliSexp_GetNew(st))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [PRINTF (format requires more args than were supplied)]", 0); + return; + } + if (!(thisArg = EliEval(st, EliCons_GetCar(argPtr)))) + return; + if (e_data_integer != EliSexp_GetType(thisArg)) { + EliError(st, ELI_ERR_BAD_ARGS, thisArg, "ELI-PRIMITIVE [PRINTF (format requires an integer)]", 0); + return; + } + argPtr = EliGetNextCell(argPtr); + printf("%ld", EliSexp_GetInt(thisArg)); + break; + case 's': + if (!argPtr) { + if (!(err = EliSexp_GetNew(st))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [PRINTF (format requires more args than were supplied)]", 0); + return; + } + if (!(thisArg = EliEval(st, EliCons_GetCar(argPtr)))) + return; + if (e_data_string != EliSexp_GetType(thisArg)) { + EliError(st, ELI_ERR_BAD_ARGS, thisArg, "ELI-PRIMITIVE [PRINTF (format requires a string)]", 0); + return; + } + argPtr = EliGetNextCell(argPtr); + printf("%s", EliStr_GetString(EliSexp_GetStr(thisArg))); + break; + case 'S': + if (!argPtr) { + if (!(err = EliSexp_GetNew(st))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [PRINTF (format requires more args than were supplied)]", 0); + return; + } + if (!(thisArg = EliEval(st, EliCons_GetCar(argPtr)))) + return; + argPtr = EliGetNextCell(argPtr); + EliDisplaySexp(thisArg); + break; + case '%': + putchar('%'); + break; + default: + EliError(st, ELI_ERR_BAD_ARGS, formatSexp, "ELI-PRIMITIVE [PRINTF (bad % directive in format)]", 0); + return; + } + } + else { + if (c == '%') + state = 1; + else + putchar(c); + } + } + EliSexp_SetSym(st, resbuf, EliTSym(st)); + } + + void Prim_PUTS(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *err; + eliDataTypes_t typeV[1]; + int evalV[1], paramStat; + EliStr_t *strTmp; + + EliDebug(20, "Entering primitive PUTS", st, FALSE); + typeV[0] = e_data_string; + evalV[0] = TRUE; + paramStat = EliProcessList(st, arglist, 1, 1, args, &err, typeV, evalV); + if ((paramStat == -1) || (paramStat == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [PUTS (checking arglist size)]", 0); + return; + } + if (paramStat == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [PUTS (arg is not a string)]", 0); + return; + } + if (paramStat < 0) + return; + printf("%s", EliStr_GetString(strTmp = EliSexp_GetStr(args[0]))); + EliSexp_SetStr(st, resbuf, strTmp); + } + + void Prim_SYSTEM(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *err; + int paramStat, evalV[1]; + eliDataTypes_t typeV[1]; + + EliDebug(20, "Entering primitive SYSTEM", st, FALSE); + evalV[0] = TRUE; + typeV[0] = e_data_string; + paramStat = EliProcessList(st, arglist, 1, 1, args, &err, typeV, evalV); + if ((paramStat == -1) || (paramStat == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [SYSTEM (checking arglist size)]", 0); + return; + } + if (paramStat == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [SYSTEM (arg is not a string)]", 0); + return; + } + if (paramStat < 0) + return; + EliSexp_SetInt(st, resbuf, (long) system(EliStr_GetString(EliSexp_GetStr(args[0])))); + } + + void Prim_GETENV(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *err; + int paramStat, evalV[1]; + eliDataTypes_t typeV[1]; + char *val; + EliStr_t *strTmp; + + EliDebug(20, "Entering primitive GETENV", st, FALSE); + evalV[0] = TRUE; + typeV[0] = e_data_string; + paramStat = EliProcessList(st, arglist, 1, 1, args, &err, typeV, evalV); + if ((paramStat == -1) || (paramStat == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [GETENV (checking arglist size)]", 0); + return; + } + if (paramStat == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [GETENV (arg is not a string)]", 0); + return; + } + if (paramStat < 0) + return; + if (val = getenv(EliStr_GetString(EliSexp_GetStr(args[0])))) { + if (!(strTmp = eliStringTable_FindOrMake(st, EliStringTable(st), val))) + return; + EliSexp_SetStr(st, resbuf, strTmp); + } + else + EliSexp_SetSym(st, resbuf, EliNilSym(st)); + } + + void Prim_DEBUG(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[2], *err; + eliDataTypes_t typeV[2]; + int evalV[2], paramStat, newlevel; + static long histNum = 0; + long tmp; + char *msg, *str; + + EliDebug(20, "Entering primitive DEBUG", st, FALSE); + typeV[0] = e_data_integer; + evalV[0] = TRUE; + typeV[1] = e_data_string; + evalV[1] = TRUE; + paramStat = EliProcessList(st, arglist, 0, 2, args, &err, typeV, evalV); + if ((paramStat == -1) || (paramStat == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [DEBUG (checking arglist size)]", 0); + return; + } + if (paramStat == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [DEBUG (1st arg is not an int)]", 0); + return; + } + if (paramStat == -1001) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [DEBUG (2nd arg is not a string)]", 0); + return; + } + if (paramStat < 0) + return; + if (paramStat == 1) { + EliProcessInfo.debugStuff.curDebugLevel = (newlevel = (int) EliSexp_GetInt(args[0])); + EliSexp_SetInt(st, resbuf, (long) newlevel); + } + else { + if (paramStat == 2) { + if ((tmp = EliSexp_GetInt(args[0])) < 1L) { + EliError(st, ELI_ERR_BAD_ARGS, args[0], "ELI-PRIMITIVE [DEBUG (debug level must be 1 or greater)]", 0); + return; + } + if (!(msg = malloc(1 + strlen(str = EliStr_GetString(EliSexp_GetStr(args[1])))))) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [DEBUG (allocating debugging message string)]", 0); + return; + } + strcpy(msg, str); + EliDebug(tmp, msg, st, TRUE); + EliSexp_SetSym(st, resbuf, EliTSym(st)); + } + else { + histNum = ((tmp = EliDebugFPrintSince(stdout, histNum)) ? tmp : histNum); + EliSexp_SetInt(st, resbuf, tmp); + } + } + } + + void Prim_EQUAL(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[2], *err; + int evalV[2], paramStat; + + EliDebug(20, "Entering primitive EQUAL", st, FALSE); + evalV[0] = evalV[1] = TRUE; + paramStat = EliProcessList(st, arglist, 2, 2, args, &err, NULL, evalV); + if ((paramStat == -1) || (paramStat == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI_PRIMITIVE [EQUAL (checking arglist size)]", 0); + return; + } + if (paramStat < 0) + return; + EliSexp_SetSym(st, resbuf, EliSexpEqual(st, args[0], args[1]) ? EliTSym(st) : EliNilSym(st)); + } + + void Prim_UCSTRING(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *err; + eliDataTypes_t typeV[1]; + int evalV[1], paramStat; + char *newstr, *oldstr, *p; + EliStr_t *strTmp; + + EliDebug(20, "Entering primitive UCSTRING", st, FALSE); + typeV[0] = e_data_string; + evalV[0] = TRUE; + paramStat = EliProcessList(st, arglist, 1, 1, args, &err, typeV, evalV); + if ((paramStat == -1) || (paramStat == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [UCSTRING (checking arglist size)]", 0); + return; + } + if (paramStat == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [UCSTRING (arg is not a string)]", 0); + return; + } + if (paramStat < 0) + return; + if (!(newstr = EliStringOpBuf(strlen(oldstr = EliStr_GetString(EliSexp_GetStr(args[0]))) + 1))) { + EliError(st, ELI_ERR_OUT_OF_MEM, NULL, "ELI-PRIMITIVE [UCSTRING (allocating result string)]", 0); + return; + } + strcpy(newstr, oldstr); + for (p = newstr; *p; ++p) + if (isascii(*p) && islower(*p)) + *p = toupper(*p); + if (!(strTmp = eliStringTable_FindOrMake(st, EliStringTable(st), newstr))) + return; + EliSexp_SetStr(st, resbuf, strTmp); + } + + /* Evaluates a single argument to a symbol name; unbinds that + * symbol's function value. Does this by binding a new, + * empty fn node to the symbol. + */ + void Prim_UNBINDFN(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *err; + eliDataTypes_t typeV[1]; + int evalV[1], paramStat; + EliFn_t *fnTmp; + EliSym_t *symTmp; + + EliDebug(20, "Entering primitive UNBINDFN", st, FALSE); + typeV[0] = e_data_symbol; + evalV[0] = TRUE; + paramStat = EliProcessList(st, arglist, 1, 1, args, &err, typeV, evalV); + if ((paramStat == -1) || (paramStat == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [UNBINDFN (checking arglist size)]", 0); + return; + } + if (paramStat == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [UNBINDFN (arg is not a symbol)]", 0); + return; + } + if (paramStat < 0) + return; + if (!(fnTmp = eliFn_GetNew_trace(st, EliTraceStk(st)))) + return; + EliSym_BindFn(st, symTmp = EliSexp_GetSym(args[0]), fnTmp); + EliSexp_SetSym(st, resbuf, symTmp); + } + + void Prim_UNBIND(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *err, *sexpTmp; + eliDataTypes_t typeV[1]; + int evalV[1], paramStat; + EliSym_t *symTmp; + + EliDebug(20, "Entering primitive UNBIND", st, FALSE); + typeV[0] = e_data_symbol; + evalV[0] = TRUE; + paramStat = EliProcessList(st, arglist, 1, 1, args, &err, typeV, evalV); + if ((paramStat == -1) || (paramStat == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [UNBIND (checking arglist size)]", 0); + return; + } + if (paramStat == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [UNBIND (arg is not a symbol)]", 0); + return; + } + if (paramStat < 0) + return; + if (!(sexpTmp = EliSexp_GetNew(st))) + return; + EliSym_BindSexp(st, symTmp = EliSexp_GetSym(args[0]), sexpTmp); + EliSexp_SetSym(st, resbuf, symTmp); + } + + void Prim_DISCARD(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[1], *err; + eliDataTypes_t typeV[1]; + int evalV[1], paramStat; + EliSym_t *symTmp; + + EliDebug(20, "Entering primitive DISCARD", st, FALSE); + typeV[0] = e_data_symbol; + evalV[0] = TRUE; + paramStat = EliProcessList(st, arglist, 1, 1, args, &err, typeV, evalV); + if ((paramStat == -1) || (paramStat == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [DISCARD (checking arglist size)]", 0); + return; + } + if (paramStat == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [DISCARD (arg is not a symbol)]", 0); + return; + } + if (paramStat < 0) + return; + EliSexp_SetSym(st, resbuf, symTmp = EliSexp_GetSym(args[0])); + eliHT_Delete(st, EliSymbolTable(st), EliStr_GetString(EliSym_GetName(symTmp))); + } + + void Prim_ERROR(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *args[2], *err; + eliDataTypes_t typeV[2]; + int evalV[2], paramStat; + + EliDebug(20, "Entering primitive ERROR", st, FALSE); + typeV[0] = e_data_string; + typeV[1] = e_data_none; + evalV[0] = evalV[1] = TRUE; + paramStat = EliProcessList(st, arglist, 1, 2, args, &err, typeV, evalV); + if ((paramStat == -1) || (paramStat == -2)) { + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [ERROR (checking arglist size)]", 0); + return; + } + if (paramStat == -1000) { + EliError(st, ELI_ERR_BAD_ARGS, err, "ELI-PRIMITIVE [ERROR (1st arg not a string)]", 0); + return; + } + if (paramStat < 0) + return; + EliError(st, ELI_ERR_USERERROR, (paramStat == 2) ? args[1] : NULL, EliStr_GetString(EliSexp_GetStr(args[0])), 0); + } + + void Prim_DEFUNV(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *listElts[3], *err, *lambdavSexp, *symSexp; + EliCons_t *resultList = NULL, *argArg; + EliSym_t *theSym; + EliFn_t *fnNode; + char *name; + + EliDebug(20, "Entering primitive DEFUNV", st, FALSE); + if (3 != EliGetListCars(arglist, listElts, 3)) { + if (!(err = EliSexp_GetNew(st))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [DEFUNV (checking arglist size)]", 0); + return; + } + if (e_data_symbol != EliSexp_GetType(listElts[0])) { + EliError(st, ELI_ERR_BAD_ARGS, listElts[0], "ELI-PRIMITIVE [DEFUNV (1st arg not a symbol)]", 0); + return; + } + if (e_data_list != EliSexp_GetType(listElts[1])) { + EliError(st, ELI_ERR_BAD_ARGS, listElts[1], "ELI-PRIMITIVE [DEFUNV (2nd arg not a list)]", 0); + return; + } + if (1 != EliListLen(argArg = EliSexp_GetCons(listElts[1]))) { + EliError(st, ELI_ERR_BAD_ARGS, listElts[1], "ELI-PRIMITIVE [DEFUNV (2nd arg must have exactly one element)]", 0); + return; + } + if (EliSexp_GetType(EliCons_GetCar(argArg)) != e_data_symbol) { + EliError(st, ELI_ERR_BAD_ARGS, listElts[1], "ELI-PRIMITIVE [DEFUNV (non-symbol in parameter list)]", 0); + return; + } + if (!(lambdavSexp = EliSexp_GetNew(st))) + return; + EliSexp_SetSym(st, lambdavSexp, EliLambdavSym(st)); + if (!(resultList = EliAddToList(st, resultList, lambdavSexp))) + return; + if (!(resultList = EliAddToList(st, resultList, listElts[1]))) + return; + if (!(resultList = EliAddToList(st, resultList, listElts[2]))) + return; + if (!(fnNode = eliFn_GetNew_trace(st, EliTraceStk(st)))) + return; + eliFn_SetCons(st, fnNode, resultList); + EliSym_BindFn(st, theSym = EliSexp_GetSym(listElts[0]), fnNode); + if (eliSym_GetScope(theSym) == e_sym_known) { + if (!(symSexp = EliSexp_GetNew(st))) + return; + eliSym_SetScope(theSym, e_sym_global); + EliSexp_SetSym(st, symSexp, theSym); + eliHT_Insert(st, EliSymbolTable(st), symSexp, name = EliStr_GetString(EliSym_GetName(theSym))); + eliHT_Delete(st, EliTempSymTable(st), name); + } + EliSexp_SetSym(st, resbuf, theSym); + } + + void Prim_DEFUNVQ(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *listElts[3], *err, *lambdavqSexp, *symSexp; + EliCons_t *resultList = NULL, *argArg; + EliSym_t *theSym; + EliFn_t *fnNode; + char *name; + + EliDebug(20, "Entering primitive DEFUNVQ", st, FALSE); + if (3 != EliGetListCars(arglist, listElts, 3)) { + if (!(err = EliSexp_GetNew(st))) + return; + EliSexp_SetCons(st, err, arglist); + EliError(st, ELI_ERR_ARGLISTSIZE, err, "ELI-PRIMITIVE [DEFUNVQ (checking arglist size)]", 0); + return; + } + if (e_data_symbol != EliSexp_GetType(listElts[0])) { + EliError(st, ELI_ERR_BAD_ARGS, listElts[0], "ELI-PRIMITIVE [DEFUNVQ (1st arg not a symbol)]", 0); + return; + } + if (e_data_list != EliSexp_GetType(listElts[1])) { + EliError(st, ELI_ERR_BAD_ARGS, listElts[1], "ELI-PRIMITIVE [DEFUNVQ (2nd arg not a list)]", 0); + return; + } + if (1 != EliListLen(argArg = EliSexp_GetCons(listElts[1]))) { + EliError(st, ELI_ERR_BAD_ARGS, listElts[1], "ELI-PRIMITIVE [DEFUNVQ (2nd arg must have exactly one element)]", 0); + return; + } + if (EliSexp_GetType(EliCons_GetCar(argArg)) != e_data_symbol) { + EliError(st, ELI_ERR_BAD_ARGS, listElts[1], "ELI-PRIMITIVE [DEFUNVQ (non-symbol in parameter list)]", 0); + return; + } + if (!(lambdavqSexp = EliSexp_GetNew(st))) + return; + EliSexp_SetSym(st, lambdavqSexp, EliLambdavqSym(st)); + if (!(resultList = EliAddToList(st, resultList, lambdavqSexp))) + return; + if (!(resultList = EliAddToList(st, resultList, listElts[1]))) + return; + if (!(resultList = EliAddToList(st, resultList, listElts[2]))) + return; + if (!(fnNode = eliFn_GetNew_trace(st, EliTraceStk(st)))) + return; + eliFn_SetCons(st, fnNode, resultList); + EliSym_BindFn(st, theSym = EliSexp_GetSym(listElts[0]), fnNode); + if (eliSym_GetScope(theSym) == e_sym_known) { + if (!(symSexp = EliSexp_GetNew(st))) + return; + eliSym_SetScope(theSym, e_sym_global); + EliSexp_SetSym(st, symSexp, theSym); + eliHT_Insert(st, EliSymbolTable(st), symSexp, name = EliStr_GetString(EliSym_GetName(theSym))); + eliHT_Delete(st, EliTempSymTable(st), name); + } + EliSexp_SetSym(st, resbuf, theSym); + } + + void Prim_VERSION(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + int majr, minr; + EliSexp_t *vv[2]; + EliCons_t *result; + + EliDebug(20, "Entering primitive VERSION", st, FALSE); + if (!(vv[0] = EliSexp_GetNew(st))) + return; + if (!(vv[1] = EliSexp_GetNew(st))) + return; + EliVersion(&majr, &minr); + EliSexp_SetInt(st, vv[0], (long) majr); + EliSexp_SetInt(st, vv[1], (long) minr); + if (!(result = EliListFromCars(st, vv, 2))) + return; + EliSexp_SetCons(st, resbuf, result); + } + + void Prim_TRACE(st, arglist, resbuf) + EliState_t *st; + EliCons_t *arglist; + EliSexp_t *resbuf; + { + EliSexp_t *arg, *evalArg; + + EliDebug(20, "Entering primitive TRACE", st, FALSE); + + if (EliListLen(arglist) > 0) { + arg = EliCons_GetCar(arglist); + if (!(evalArg = EliEval(st, arg))) + return; + st->tracep = EliNilP(st, evalArg) ? FALSE : TRUE; + } + else + st->tracep = !(st->tracep); + if (!(st->tracep)) + st->indentTrace = 0; + EliSexp_SetSym(st, resbuf, st->tracep ? EliTSym(st) : EliNilSym(st)); + } *** overhead/mail/lib/fwdvalid.c Wed Nov 22 13:52:15 1989 --- overhead/mail/lib/fwdvalid.c.NEW Mon Feb 5 11:21:13 1990 *************** *** 115,126 **** wp_SearchToken STok; wp_PrimeKey KVal; wp_ErrorCode ErrCode; ! int MinMatch, OutMatch, NewLen; #endif WHITEPAGES_ENV extern ADDRESS_HOST *MakeHost(); int laErr, laType; char *laPrime, *laSecond; laErr = la_KindDomain(Addr, &laType, &laPrime, &laSecond, PrevailingDomain); /* If all the hosts were just removed, we're local; add back the preferred name of our host. */ if (Addr->Hosts == Addr->Hosts->Next) { --- 115,127 ---- wp_SearchToken STok; wp_PrimeKey KVal; wp_ErrorCode ErrCode; ! int MinMatch, OutMatch, NewLen, AMSDel, PlusOK; #endif WHITEPAGES_ENV extern ADDRESS_HOST *MakeHost(); int laErr, laType; char *laPrime, *laSecond; + laSecond = NULL; laErr = la_KindDomain(Addr, &laType, &laPrime, &laSecond, PrevailingDomain); /* If all the hosts were just removed, we're local; add back the preferred name of our host. */ if (Addr->Hosts == Addr->Hosts->Next) { *************** *** 294,299 **** --- 295,307 ---- /* It's a local name, either latype_LocalID or latype_LocalName--try to evaluate it. */ #ifdef WHITEPAGES_ENV + AMSDel = CheckAMSDelivery(PrevailingDomain); + if (AMSDel <= 0 && CheckAMSValidationMask(PrevailingDomain) != vld_WPValid) { + /* can't do validation within PrevailingDomain: return with no further changes */ + free(laPrime); + return; + } + PlusOK = (AMSDel > 0); if ((!wpCD) || (strcmp(PrevailingDomain, wp_domain))) { /* need to initialize WP */ wp_ErrorCode err; *************** *** 401,410 **** if (KVal != NULL) free(KVal); free(laPrime); return; } ! if (laType == latype_LocalID) { (void) sprintf(NewName, "%s+%s", CanonID, laSecond); } else { ! (void) sprintf(NewName, "%s+", CanonID); } if (Addr->LocalPart != NULL) free(Addr->LocalPart); Addr->LocalPart = NewName; --- 409,418 ---- if (KVal != NULL) free(KVal); free(laPrime); return; } ! if (PlusOK) { (void) sprintf(NewName, "%s+%s", CanonID, laSecond); } else { ! (void) strcpy(NewName, CanonID); } if (Addr->LocalPart != NULL) free(Addr->LocalPart); Addr->LocalPart = NewName; *** overhead/pobbconf/pobb-install.pobb Wed Jan 17 16:41:17 1990 --- overhead/pobbconf/pobb-install.pobb.NEW Mon Feb 5 11:23:14 1990 *************** *** 789,795 **** --- 789,799 ---- %endif pobb_RunAMSDelivery %ifdef pobb_AutoPost + %ifdef pobb_DowJonesIn foreach DR ( ?[arrlist(CUILocalBoxes)] ?[arrlist(CUIExtBoxes)] ?[arrlist(CUIDJBoxes)] ) + %else pobb_DowJonesIn + foreach DR ( ?[arrlist(CUILocalBoxes)] ?[arrlist(CUIExtBoxes)] ) + %endif pobb_DowJonesIn if ( -d $${DR} ) then %ifdef pobbenv_AFS if ( "$${DR}" =~ ?[CellCommonPrefix]* ) $$FS setacl $${DR} ?[arrlist(PostmanDirOwners, " rlidka ")] rlidka ?[generalEnqueueingPublic] lik *** overhead/pobbconf/post.office.pobb Wed Jan 17 16:41:18 1990 --- overhead/pobbconf/post.office.pobb.NEW Mon Feb 5 11:23:16 1990 *************** *** 23,33 **** %ifdef pobb_RunMachines - %ifdef pobbenv_CMU - ?[QuotedPercent]define ownvmunix 1 - FOAQ /vmunix $${machine}/vmunix.afs.new $${binmode} - %endif pobbenv_CMU - ?[QuotedPercent]ifdef rt_r3 ?[QuotedPercent]define haspasswd FA /etc/passwd ?[PackageHome]/etc/passwd $${textmode} --- 23,28 ---- *** overhead/pobbconf/dj-startup.pobb Wed Nov 22 14:46:41 1989 --- overhead/pobbconf/dj-startup.pobb.NEW Mon Feb 5 11:23:18 1990 *************** *** 10,16 **** # ?[POBBRunNotice] %ifdef pobb_DowJonesIn ! ?[SmallLocalDir]/dj ?[DJLocalDir] >/dev/null & /bin/echo -n " dow-jones" > /dev/console %ifdef pobbenv_AFS --- 10,16 ---- # ?[POBBRunNotice] %ifdef pobb_DowJonesIn ! (setenv ANDREWDIR /usr/local : ?[SmallLocalDir]/dj ?[DJLocalDir] >/dev/null &) /bin/echo -n " dow-jones" > /dev/console %ifdef pobbenv_AFS END OF ANDREW PATCH 4