home *** CD-ROM | disk | FTP | other *** search
/ ftp.mactech.com 2010 / ftp.mactech.com.tar / ftp.mactech.com / online / source / c / compilers / Tickle-4.0.sit.hqx / Tickle-4.0 / src / XTCL_callback.p < prev    next >
Text File  |  1993-11-18  |  3KB  |  156 lines
  1.  
  2. { This source code was written by Tim Endres                }
  3. { Email: time@ice.com.                                        }
  4. { USMail: 8840 Main Street, Whitmore Lake, MI  48189        }
  5. {                                                            }
  6. { Some portions of this application utilize sources            }
  7. { that are copyrighted by ICE Engineering, Inc., and        }
  8. { ICE Engineering retains all rights to those sources.        }
  9. {                                                            }
  10. { Neither ICE Engineering, Inc., nor Tim Endres,            }
  11. { warrants this source code for any reason, and neither        }
  12. { party assumes any responsbility for the use of these        }
  13. { sources, libraries, or applications. The user of these    }
  14. { sources and binaries assumes all responsbilities for        }
  15. { any resulting consequences.                                }
  16.  
  17.  
  18. UNIT XTCLEntry;
  19.  
  20. INTERFACE
  21.  
  22.     USES Types, Memory, Dialogs;
  23.     
  24.     CONST
  25.         TCL_OK            = 0;
  26.         TCL_ERROR        = 1;
  27.         TCL_RETURN        = 2;
  28.         TCL_BREAK        = 3;
  29.         TCL_CONTINUE    = 4;
  30.     
  31.     TYPE
  32.         Tcl_Interp        = Ptr;
  33.         ARGV_Ptr        = ARRAY[1..50] OF Ptr;
  34.     
  35.         XTCLParmBlk        =
  36.         RECORD
  37.             version:    longint;            { Version of the Cmd interface. }
  38.             result:        longint;            { CMD's operation result code. }
  39.             resultH:    Handle;                { CMD's result handle. }
  40.             cmdRefNum:    integer;            { Cmd file reference number. }
  41.             cmdHandle:    Handle;                { CMD's command code handle. }
  42.             interp:        Tcl_Interp;            { Interpreter calling this XTCL. }
  43.             eval:        ProcPtr;            { Callback procedure (C) for tcl script evaluation }
  44.             modalproc:    ModalFilterProcPtr;    { Routine for ModalDialog() to keep background. }
  45.             reserved:    longint;
  46.         END;    
  47.     
  48.     PROCEDURE PXTCLEntry(argc: longint ; argv: ARGV_Ptr ; xpb: XTCLParmBlk);
  49.     PROCEDURE Cstrcpy(tstr: Ptr ; fstr: Ptr);
  50.     FUNCTION Cstrlen(str: Ptr): longint;
  51.     
  52. IMPLEMENTATION
  53.  
  54.     FUNCTION XTCLCallBack(xpb: XTCLParmBlk ; sH: Handle ; rH: Handle ; oH: Handle): longint;
  55.         EXTERNAL;
  56.     
  57.     PROCEDURE PXTCLEntry;
  58.  
  59.     VAR 
  60.         p:            Ptr;
  61.         length:        longint;
  62.         result:        longint;
  63.         rHandle:    Handle;
  64.         sHandle:    Handle;
  65.         script:        Ptr;
  66.     
  67.     BEGIN
  68.     
  69.         xpb.result := TCL_OK;
  70.         
  71.         script := argv[2];
  72.         length := Cstrlen(script);
  73.         
  74.         sHandle := NewHandle(length+1);
  75.         rHandle := NewHandle(0);
  76.         
  77.         IF (sHandle <> NIL) AND (rHandle <> NIL)
  78.         THEN
  79.             BEGIN
  80.             
  81.             p := sHandle^;
  82.             BlockMove(script, sHandle^, length);
  83.             result := XTCLCallBack(xpb, sHandle, rHandle, NIL);
  84.             
  85.             length := GetHandleSize(rHandle);
  86.             p := Pointer(Ord4(sHandle^) + length);
  87.             p^ := 0;
  88.             
  89.             SetHandleSize(xpb.resultH, length + 1);
  90.             if (MemError = noErr)
  91.             THEN
  92.                 BEGIN
  93.                 BlockMove(rHandle^, xpb.resultH^, GetHandleSize(rHandle));
  94.                 p := Pointer(Ord4(xpb.resultH^) + length);
  95.                 p^ := 0;
  96.                 END
  97.             ELSE
  98.                 BEGIN
  99.                 result := TCL_ERROR;
  100.                 END;
  101.             
  102.             xpb.result := result;
  103.             END;
  104.         
  105.         IF (sHandle <> NIL)
  106.         THEN
  107.             BEGIN
  108.             DisposHandle(sHandle);
  109.             END;
  110.         
  111.         IF (rHandle <> NIL)
  112.         THEN
  113.             BEGIN
  114.             DisposHandle(rHandle);
  115.             END;
  116.     
  117.         END;
  118.  
  119.     PROCEDURE Cstrcpy;
  120.  
  121.     VAR 
  122.         fp:        Ptr;
  123.         tp:        Ptr;
  124.         i:        integer;
  125.         
  126.     BEGIN
  127.     
  128.         i := 0;
  129.         REPEAT
  130.             fp := Pointer(Ord4(fstr) + i);
  131.             tp := Pointer(Ord4(tstr) + i);
  132.             tp^ := fp^;
  133.             i := i + 1;
  134.             UNTIL tp^ = 0;
  135.  
  136.         END;
  137.     
  138.     FUNCTION Cstrlen;
  139.  
  140.     VAR 
  141.         p:        Ptr;
  142.         i:        integer;
  143.     
  144.     BEGIN
  145.     
  146.         i := 0;
  147.         REPEAT
  148.             p := Pointer(Ord4(str) + i);
  149.             i := i + 1;
  150.             UNTIL p^ = 0;
  151.  
  152.         Cstrlen := i - 1;
  153.         END;
  154.  
  155. END.
  156.