home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / windows / c / xlisp21w / sources / xlisp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-02-28  |  7.2 KB  |  308 lines
  1. /* xlisp.c - a small implementation of lisp with object-oriented programming */
  2. /*      Copyright (c) 1987, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use       */
  5.  
  6. /* For full credits see file xlisp.h */
  7.  
  8. #include "xlisp.h"
  9.  
  10. /* global variables */
  11. #ifdef SAVERESTORE
  12. jmp_buf top_level;
  13. #endif
  14.  
  15. /* external variables */
  16. extern LVAL s_stdin,s_stdout,s_evalhook,s_applyhook;
  17. extern LVAL s_1plus,s_2plus,s_3plus,s_1star,s_2star,s_3star,s_minus;
  18. extern int xltrcindent;
  19. extern int xldebug;
  20. extern LVAL true;
  21. extern FILEP tfp;
  22.  
  23. static char    string[96];
  24. static int    verbose;
  25. static char     resfile[96] = "xlisp.wks";
  26.  
  27. /* Functions from winstuff.c */
  28. void    EnableMenuCommands();
  29. void    DisableMenuCommands();
  30.  
  31. extern long FAR PASCAL WndProc( HWND , WORD , WORD , LONG );
  32.  
  33. /* Processes the command line. Gets a pointer to the command
  34.    line and a flag which shows the processing pass. The switches
  35.    (beginning with '-') are processed before the main window is
  36.    created , then LispFlag is FALSE. LispFlag is TRUE , when
  37.    the Lisp sources are loaded after the initialization of the
  38.    system */
  39. void ProcessCommandLine( LPSTR CmdLine , int LispFlag )
  40. {
  41.   char        *p1;
  42.   char        s[100];
  43.   CONTEXT       cntxt;
  44.  
  45.   while( *CmdLine )
  46.   {
  47.     while( *CmdLine == ' ' )
  48.         ++CmdLine;
  49.     p1 = string;
  50.     while( *CmdLine && *CmdLine != ' ' )
  51.         *( p1++ ) = *( CmdLine++ );
  52.     *p1 = 0;
  53.     if( *string )
  54.     {
  55.       if( *string != '-' )    /* load Lisp source if in the
  56.                    second pass*/
  57.       {
  58.     if (setjmp(cntxt.c_jmpbuf) == 0 && LispFlag )
  59.       if( !xlload( string ,TRUE,verbose))
  60.       {
  61.         sprintf( s , "Can't load file : %s", string );
  62.         MessageBox( NULL , s , "XLisp" , MB_OK );
  63.       }
  64.       }
  65.       else
  66.       if( !LispFlag )
  67.     switch( string[1] )    /* else process switches */
  68.     {
  69.       case 'v':
  70.         verbose = TRUE;
  71.         break;
  72.  
  73.       case 'w':
  74.         strcpy( resfile , &string[2] );
  75.         break;
  76.  
  77.       case 's':
  78.         ServerTask = TRUE;
  79.         break;
  80.  
  81.       default:
  82.         sprintf( s , "Invalid switch : %s" , string );
  83.         MessageBox( NULL , s , "XLisp" , MB_OK );
  84.         break;
  85.     }        /* switch */
  86.     }            /* if( *string ) */
  87.   }            /* while */
  88. }
  89.  
  90. int PASCAL WinMain( HANDLE hInstance , HANDLE hPrevInstance ,
  91.             LPSTR lpCmdLine , int nCmdShow )
  92. {
  93.   static char    szAppName[] = "XLisp";
  94.   static char    szAppCapt[] = "XLisp";
  95.  
  96.   FARPROC    DlgProc;
  97.   WNDCLASS    WndClass;
  98.   CONTEXT    cntxt;
  99.   int        i;
  100.   char        far *ReplyBuf;
  101.   DWORD        Style;
  102.   LVAL        expr;
  103.  
  104.   ServerTask = FALSE;
  105.   ProcessCommandLine( lpCmdLine , FALSE );
  106.   hInst = hInstance;
  107.   if( !hPrevInstance )
  108.   {
  109.     WndClass.style = CS_HREDRAW | CS_VREDRAW;
  110.     WndClass.lpfnWndProc = WndProc;
  111.     WndClass.cbClsExtra = 0;
  112.     WndClass.cbWndExtra = 0;
  113.     WndClass.hInstance = hInst;
  114.     WndClass.hIcon = LoadIcon( hInst,szAppName );
  115.     WndClass.hCursor = LoadCursor( NULL, IDC_ARROW );
  116.     WndClass.hbrBackground = COLOR_WINDOW + 1;
  117.     WndClass.lpszMenuName = szAppName;
  118.     WndClass.lpszClassName = szAppName;
  119.     RegisterClass( &WndClass );
  120.   }
  121.  
  122.   strcpy( string , szAppCapt );
  123. /* Adds "server" to the caption string if server */
  124.   if( ServerTask )
  125.     strcat( string , " server" );
  126.   MainWindow = CreateWindow( szAppName ,
  127.                string ,
  128.                WS_OVERLAPPEDWINDOW,
  129.                CW_USEDEFAULT ,
  130.                CW_USEDEFAULT ,
  131.                CW_USEDEFAULT ,
  132.                CW_USEDEFAULT ,
  133.                NULL ,
  134.                NULL ,
  135.                hInst ,
  136.                NULL );
  137.  
  138. /* initialize */
  139.   osinit();
  140. /* start minimized anyway if server task */
  141.   if( ServerTask )
  142.     nCmdShow = SW_MINIMIZE;
  143.   ShowWindow( MainWindow , nCmdShow );
  144.   InvalidateRect( MainWindow , NULL , TRUE );
  145.   UpdateWindow( MainWindow );
  146.   hAccel = LoadAccelerators( hInst , szAppName );
  147.  
  148.     /* setup default argument values */
  149.     verbose = FALSE;
  150.  
  151.     /* setup initialization error handler */
  152.     xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,(LVAL)1);
  153.     if (setjmp(cntxt.c_jmpbuf))
  154.     xlfatal("fatal initialization error");
  155. #ifdef SAVERESTORE
  156.     if (setjmp(top_level))
  157.     xlfatal("RESTORE not allowed during initialization");
  158. #endif
  159.  
  160.     /* initialize xlisp */
  161. #ifdef SAVERESTORE
  162.     i = xlinit(resfile);
  163. #else
  164.     i = xlinit(NULL);
  165. #endif
  166.  
  167.     /* reset the error handler, since we know what "true" is */
  168.     xlend(&cntxt);
  169.     xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,true);
  170.  
  171.     /* load "init.lsp" */
  172.     if (i && (setjmp(cntxt.c_jmpbuf) == 0))
  173.     xlload("init.lsp",TRUE,FALSE);
  174.  
  175. /* Process Lisp sources in the command line now */
  176.     ProcessCommandLine( lpCmdLine , TRUE );
  177.  
  178.     /* target for restore */
  179. #ifdef SAVERESTORE
  180.     if (setjmp(top_level))
  181.     xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,true);
  182. #endif
  183.  
  184.     /* protect some pointers */
  185.     xlsave1(expr);
  186.  
  187.  
  188.     /* main command processing loop */
  189.     for (;;) {
  190.  
  191.     /* setup the error return */
  192.     if (setjmp(cntxt.c_jmpbuf)) {
  193.         setvalue(s_evalhook,NIL);
  194.         setvalue(s_applyhook,NIL);
  195.         xltrcindent = 0;
  196.         xldebug = 0;
  197.         xlflush();
  198.     }
  199.  
  200. /* Sending reply packet to the XServer DLL */
  201.     if( ServerPacket )
  202.     {
  203.       ReplyBuf = GlobalLock( ReplyBlock );
  204.       ReplyBuf[ ReplyIndex ] = 0;
  205.       XDSendReply( ReplyBuf );
  206.       GlobalUnlock( ReplyBlock );
  207.       GlobalFree( ReplyBlock );
  208.       ServerPacket = FALSE;
  209.     }
  210.  
  211.     stdputstr("> ");
  212.  
  213.     /* Enabling popup menu commands */
  214.     EnableMenuCommands();
  215.  
  216.     /* read an expression */
  217.     if (!xlread(getvalue(s_stdin),&expr))
  218.       if( MenuCommand == FUNC_EOF )
  219.         break;
  220.       else
  221.       if( MenuCommand == FUNC_LLSP )
  222.       {
  223.         xlload( szFileName , TRUE , FALSE );
  224.         continue;
  225.       }
  226.       else
  227.       if( MenuCommand == FUNC_LWKS )
  228.       {
  229.         sprintf( string , "; Loading %s\n" , szFileName );
  230.         stdputstr( string );
  231.         xlirestore( szFileName );
  232.         dbgputstr( "[ returning to the top level ]\n" );
  233.         longjmp( top_level,1 );
  234.       }
  235.  
  236. /* Begin processing a client packet */
  237.     if( ServerReady )
  238.     {
  239.       ServerReady = FALSE;
  240.       ServerPacket = ( ReplyBlock = GlobalAlloc( GMEM_MOVEABLE ,
  241.               RBLOCK_SIZE ) ) != NULL;
  242.       ReplyIndex = 0;
  243.     }
  244.  
  245.     /* Disabling popup menu commands */
  246.     DisableMenuCommands();
  247.  
  248.     /* save the input expression */
  249.     xlrdsave(expr);
  250.  
  251.     /* evaluate the expression */
  252.     expr = xleval(expr);
  253.  
  254.     /* save the result */
  255.     xlevsave(expr);
  256.  
  257.     /* Show result on a new line -- TAA MOD to improve display */
  258.     xlfreshline(getvalue(s_stdout));
  259.  
  260.     /* print it */
  261.     stdprint(expr);
  262.  
  263.     }
  264.     xlend(&cntxt);
  265.  
  266.     /* clean up */
  267.     wrapup();
  268.  
  269.     return 0;
  270. }
  271.  
  272. /* xlrdsave - save the last expression returned by the reader */
  273. VOID xlrdsave(expr)
  274.   LVAL expr;
  275. {
  276.     setvalue(s_3plus,getvalue(s_2plus));
  277.     setvalue(s_2plus,getvalue(s_1plus));
  278.     setvalue(s_1plus,getvalue(s_minus));
  279.     setvalue(s_minus,expr);
  280. }
  281.  
  282. /* xlevsave - save the last expression returned by the evaluator */
  283. VOID xlevsave(expr)
  284.   LVAL expr;
  285. {
  286.     setvalue(s_3star,getvalue(s_2star));
  287.     setvalue(s_2star,getvalue(s_1star));
  288.     setvalue(s_1star,expr);
  289. }
  290.  
  291. /* xlfatal - print a fatal error message and exit */
  292. VOID xlfatal(msg)
  293.   char *msg;
  294. {
  295.     xoserror(msg);
  296.     wrapup();
  297. }
  298.  
  299. /* wrapup - clean up and exit to the operating system */
  300. VOID wrapup()
  301. {
  302.     /* $putpatch.c$: "MODULE_XLISP_C_WRAPUP" */
  303.     if (tfp != CLOSED)
  304.         OSCLOSE(tfp);
  305.     osfinish();
  306.     exit(0);
  307. }
  308.