home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / tcl / tclsrc / c / tclsh < prev    next >
Encoding:
Text File  |  1996-01-14  |  2.2 KB  |  94 lines
  1. /*
  2.  Main for Tclsh
  3.  (c) C.T.Stretch
  4.  Fri,24 Jun 1994
  5. */
  6.  
  7. #include <stdio.h>
  8. #include <stdlib.h>
  9. #include "h.tclInt"
  10. #include "h.tclRISCOS"
  11. #undef UCHAR
  12. #include "h.os"
  13.  
  14. static Tcl_Interp *ti;
  15. static char flags[26];
  16.  
  17. static void getflags(char *q)
  18. { bool toggle=TRUE;
  19.   for(;*q;q++) if(*q=='~') toggle=!toggle;
  20.   else if(*q>='a'&&*q<='z') {flags[*q-'a']=toggle;toggle=TRUE;}
  21. }
  22.  
  23. static int file_eval(char *fname)
  24. { int code=Tcl_EvalFile(ti,fname);
  25.   char *q;
  26.   if(code)
  27.   { printf("Error %d from Tclsh - %s\n",code,ti->result);
  28.     q=Tcl_GetVar(ti,"errorInfo",0);
  29.     if(q) puts(q);
  30.     if(!flags['e'-'a']) exit(code);
  31.   }
  32.   return code;
  33. }
  34.  
  35. static void banner()
  36. { puts("Tclsh version " TCL_VERSION "   Tcl Interpreter");
  37.   puts("Generic functions with RISCOS extensions");
  38.   puts("Compiled " __DATE__ );
  39. }
  40.  
  41. static int DoOneCmd()
  42. { char buf[257];
  43.   Tcl_DString cmd;
  44.   int code;
  45.   Tcl_DStringInit(&cmd);
  46.   fputs(">",stdout);
  47.   for(;;)
  48.   { if(!fgets(buf,sizeof(buf),stdin)) break;
  49.     Tcl_DStringAppend(&cmd,buf,-1);
  50.     if(Tcl_CommandComplete(Tcl_DStringValue(&cmd))) break;
  51.     fputs(">>",stdout);
  52.   }
  53.   code=Tcl_RecordAndEval(ti,Tcl_DStringValue(&cmd),0);
  54.   Tcl_DStringFree(&cmd);
  55.   return 0;
  56. }
  57.  
  58. int main(int n,char** args)
  59. { int i,k,filearg=0;
  60.   char j;
  61.   char *q;
  62.   char buf[32];
  63.   RiscOS_Init();
  64.   ti=Tcl_CreateInterp();
  65.   Tcl_CreateCommand(ti,"history",Tcl_HistoryCmd,NULL,NULL);
  66.   RiscOS_InitVars(ti);
  67.   q=getenv("Tclsh$Options");
  68.   if(q) getflags(q);
  69.   i=1;
  70.   if(n>i&&args[i][0]=='-') getflags(args[i++]);
  71.   if(flags['b'-'a']) banner();
  72.   q=buf;
  73.   for(j='a';j<='z';j++) if(flags[j-'a']) *q++=j;
  74.   *q=0;
  75.   Tcl_SetVar2(ti,"argv","flags",buf,TCL_GLOBAL_ONLY);
  76.   q="";
  77.   if(n>i) { q=args[i];filearg=i++;}
  78.   Tcl_SetVar2(ti,"argv","file",q,TCL_GLOBAL_ONLY);
  79.   sprintf(buf,"%d",n-i);
  80.   Tcl_SetVar2(ti,"argc",0,buf,TCL_GLOBAL_ONLY);
  81.   for(k=0;k<n-i;k++)
  82.   { sprintf(buf,"%d",k);
  83.     Tcl_SetVar2(ti,"argv",buf,args[k+i],TCL_GLOBAL_ONLY);
  84.   }
  85.   if(flags['i'-'a']&&file_eval("<tcl$Dir>.library.init")) goto cmdline;
  86.   if(filearg&&file_eval(args[filearg])) goto cmdline;
  87.   if(!flags['c'-'a']) return 0;
  88.   cmdline:for(;;)
  89.   { int code=DoOneCmd();
  90.     if(code) printf("\nError %d - %s\n",code,ti->result);
  91.     else puts(ti->result);
  92.   }
  93. }
  94.