langwinipc.c

Go to the documentation of this file.
00001 
00002 /*  $Id: langwinipc.c 1260 2006-04-13 06:13:10Z sethdill $    */
00003 
00004 /******************************************************************************
00005 
00006     UserLand Frontier(tm) -- High performance Web content management,
00007     object database, system-level and Internet scripting environment,
00008     including source code editing and debugging.
00009 
00010     Copyright (C) 1992-2004 UserLand Software, Inc.
00011 
00012     This program is free software; you can redistribute it and/or modify
00013     it under the terms of the GNU General Public License as published by
00014     the Free Software Foundation; either version 2 of the License, or
00015     (at your option) any later version.
00016 
00017     This program is distributed in the hope that it will be useful,
00018     but WITHOUT ANY WARRANTY; without even the implied warranty of
00019     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00020     GNU General Public License for more details.
00021 
00022     You should have received a copy of the GNU General Public License
00023     along with this program; if not, write to the Free Software
00024     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
00025 
00026 ******************************************************************************/
00027 
00028 #include "frontier.h"
00029 #include "standard.h"
00030 
00031 #ifdef MACVERSION
00032 #include "langxcmd.h"
00033 #endif
00034 
00035 #include "memory.h"
00036 #include "frontierconfig.h"
00037 #include "cursor.h"
00038 #include "dialogs.h"
00039 #include "error.h"
00040 #include "font.h"
00041 #include "kb.h"
00042 #include "mouse.h"
00043 #include "ops.h"
00044 #include "quickdraw.h"
00045 #include "resources.h"
00046 #include "sounds.h"
00047 #include "strings.h"
00048 #include "frontierwindows.h"
00049 #include "shell.h"
00050 #include "shellhooks.h"
00051 #include "oplist.h"
00052 #include "lang.h"
00053 #include "langinternal.h"
00054 #include "langexternal.h"
00055 #include "langipc.h"
00056 #include "langdll.h"
00057 #include "langsystem7.h"
00058 #include "langtokens.h"
00059 #include "langwinipc.h"
00060 #include "BASE64.H"
00061 #include "tablestructure.h"
00062 #include "tableverbs.h"
00063 #include "process.h"
00064 #include "processinternal.h"
00065 #include "kernelverbdefs.h"
00066 #include "WinSockNetEvents.h"
00067 #include "notify.h"
00068 #include "timedate.h"
00069 
00070 
00071 boolean langwinipcerrorroutine (bigstring bs, ptrvoid refcon) {
00072 #pragma unused (refcon)
00073 
00074     /*
00075     if an error occurs while processing a runscript verb, we want to 
00076     return the text that would normally go into the langerror window as 
00077     an error string to our caller.
00078     */
00079     
00080     tyvaluerecord * val = nil;
00081     
00082     if (currentprocess != nil)
00083         val = (tyvaluerecord *) (**currentprocess).processrefcon;
00084     
00085     if (val == nil)
00086         return (false);     //should never be....
00087     
00088     setstringvalue (bs, val);
00089 
00090     exemptfromtmpstack (val);
00091 
00092     return (false); /*consume the error*/
00093     } /*langwinipcerrorroutine*/
00094 
00095 
00096 #ifdef WIN95VERSION
00097 
00098 static void langwinipchookerrors (langerrormessagecallback *savecallback) {
00099     
00100     *savecallback = langcallbacks.errormessagecallback;
00101     
00102     langcallbacks.errormessagecallback = &langwinipcerrorroutine;
00103     
00104     shellpusherrorhook ((errorhookcallback) &langwinipcerrorroutine);
00105     
00106 //  hipcverb = hverb; /*make visible to errorroutine*/
00107     } /*langwinipchookerrors*/
00108 
00109 
00110 static boolean langwinipcunhookerrors (langerrormessagecallback savecallback) {
00111     
00112     shellpoperrorhook ();
00113     
00114     langcallbacks.errormessagecallback = savecallback;
00115     
00116     fllangerror = false; /*make sure error flag is cleared*/
00117     
00118 //  hipcverb = nil;
00119     
00120     return (true);
00121     } /*langwinipcunhookerrors*/
00122 
00123 
00124 static boolean langwinipccoerceparam (VARIANTARG * var, tyvaluerecord * val);
00125 
00126 boolean convertBSTRVariantToValue (VARIANTARG * var, tyvaluerecord * val) {
00127     int cSize;
00128     int cOut;
00129     Handle h;
00130 
00131     if (V_VT(var) == VT_BSTR) {  /*just make sure it is a string */
00132         if (V_BSTR(var) != NULL) {
00133             cSize = WideCharToMultiByte(CP_ACP,0,V_BSTR(var),-1,NULL,0,NULL,NULL);
00134 
00135             if (cSize != 0) {
00136                 if (newhandle ((cSize+1), &h)) {
00137                     cOut = WideCharToMultiByte(CP_ACP,0,V_BSTR(var),-1,*h,cSize,NULL,NULL);
00138 
00139                     if (cOut != 0) {
00140                         sethandlesize (h, cOut-1);
00141 
00142                         setheapvalue(h, stringvaluetype, val);
00143 
00144                         return (true);
00145                         }
00146 
00147                     disposehandle (h);
00148                     }
00149                 }
00150             }
00151         }
00152 
00153     return (false);
00154     } /*convertBSTRVariantToValue*/
00155 
00156 static boolean insertToList (hdllistrecord hlist, tyvaluerecord * val) {
00157     boolean res;
00158 
00159     res = langpushlistval (hlist, nil, val);
00160 
00161     return (res);
00162     } /*insertToList*/
00163 
00164 static boolean insertToTable (hdlhashtable htable, tyvaluerecord * val2, tyvaluerecord * val1) {
00165     bigstring name;
00166     boolean res;
00167     long ct;
00168     bigstring serializedname;
00169     
00170     if (val2->valuetype != stringvaluetype)
00171         return (false);
00172 
00173     hashcountitems (htable, &ct);
00174     
00175     numbertostring (ct + 1, serializedname);
00176     
00177     while (stringlength (serializedname) < 4)
00178         insertchar ('0', serializedname);
00179     
00180     pushchar ('\t', serializedname);
00181 
00182     pullstringvalue (val2, name);
00183 
00184     //uncomment out the line below if we think that matrix (tables) should be order dependent.
00185     //I'm mixed, right now I think not.  It is the name that matters.
00186         
00187 //  insertstring (serializedname, name);
00188 
00189     pushhashtable (htable);
00190 
00191     res = hashinsert (name, *val1);
00192 
00193     pophashtable();
00194 
00195     return (res);
00196     } /*insertToTable*/
00197 
00198 static boolean getArrayElement (VARTYPE elementType, SAFEARRAY *psa, long * index, tyvaluerecord * val) {
00199     boolean res;
00200     HRESULT hres;
00201     VARIANTARG var;
00202 
00203     res = true;
00204 
00205     VariantInit (&var);
00206 
00207     switch (elementType) {
00208         case VT_EMPTY:
00209         case VT_NULL:
00210             setlongvalue (0, val);
00211             break;
00212 
00213         case VT_I2: {
00214             short fooI2;
00215 
00216             hres = SafeArrayGetElement (psa, index, &fooI2);
00217 
00218             if (FAILED(hres))
00219                 return (false);
00220 
00221             setintvalue (fooI2, val);
00222             break;
00223             }
00224 
00225         case VT_I4: {
00226             long fooI4;
00227 
00228             hres = SafeArrayGetElement (psa, index, &fooI4);
00229 
00230             if (FAILED(hres))
00231                 return (false);
00232 
00233             setlongvalue (fooI4, val);
00234             break;
00235             }
00236 
00237         case VT_R4: {
00238             float fooR4;
00239 
00240             hres = SafeArrayGetElement (psa, index, &fooR4);
00241 
00242             if (FAILED(hres))
00243                 return (false);
00244 
00245             setsinglevalue (fooR4, val);
00246             break;
00247             }
00248 
00249         case VT_R8: {
00250             double fooR8;
00251 
00252             hres = SafeArrayGetElement (psa, index, &fooR8);
00253 
00254             if (FAILED(hres))
00255                 return (false);
00256 
00257             setdoublevalue (fooR8, val);
00258             break;
00259             }
00260 
00261         case VT_BOOL: {
00262             short fooBOOL;
00263 
00264             hres = SafeArrayGetElement (psa, index, &fooBOOL);
00265 
00266             if (FAILED(hres))
00267                 return (false);
00268 
00269             setbooleanvalue (fooBOOL, val);
00270             break;
00271             }
00272 
00273         case VT_UI1: {
00274             unsigned char fooUI1;
00275 
00276             hres = SafeArrayGetElement (psa, index, &fooUI1);
00277 
00278             if (FAILED(hres))
00279                 return (false);
00280 
00281             setcharvalue (fooUI1, val);
00282             break;
00283             }
00284 
00285         case VT_BSTR: {
00286             BSTR fooBSTR;
00287 
00288             hres = SafeArrayGetElement (psa, index, &fooBSTR);
00289 
00290             if (FAILED(hres))
00291                 return (false);
00292 
00293             V_VT(&var) = VT_BSTR;
00294 
00295             V_BSTR(&var) = fooBSTR;
00296 
00297             return (convertBSTRVariantToValue (&var, val));
00298             break;
00299             }
00300 
00301         case VT_DATE: {
00302             DATE fooDATE;
00303 
00304             hres = SafeArrayGetElement (psa, index, &fooDATE);
00305 
00306             if (FAILED(hres))
00307                 return (false);
00308 
00309             V_VT(&var) = VT_DATE;
00310 
00311             V_DATE(&var) = fooDATE;
00312 
00313             return (langwinipccoerceparam (&var, val));
00314             break;
00315             }
00316 
00317         case VT_CY: {
00318             CY fooCY;
00319 
00320             hres = SafeArrayGetElement (psa, index, &fooCY);
00321 
00322             if (FAILED(hres))
00323                 return (false);
00324 
00325             V_VT(&var) = VT_CY;
00326 
00327             V_CY(&var) = fooCY;
00328 
00329             return (langwinipccoerceparam (&var, val));
00330             break;
00331             }
00332 
00333         case VT_VARIANT: {
00334             hres = SafeArrayGetElement (psa, index, &var);
00335 
00336             if (FAILED(hres))
00337                 return (false);
00338 
00339             return (langwinipccoerceparam (&var, val));
00340             break;
00341             }
00342 
00343 
00344         case VT_ERROR:
00345         case VT_DISPATCH:
00346         case VT_UNKNOWN:
00347         default:
00348             res = false;
00349         }
00350 
00351     return (res);
00352     } /*getArrayElement*/
00353 
00354 
00355 static boolean langwinipccoercearray (VARIANTARG * var, tyvaluerecord * val) {
00356     SAFEARRAY FAR *psa;
00357     HRESULT hres;
00358     unsigned int dimCount, elementSize;
00359     long ub1, lb1, ub2, lb2, k;
00360     long index[2];      /*we only support upto 2 dimensions */
00361     tyvaluerecord val1, val2;
00362     hdllistrecord hlist;
00363     hdlhashtable htable;
00364     VARTYPE elementType;
00365 
00366     hlist = NULL;
00367     htable = NULL;
00368 
00369     if (V_ISBYREF(var))
00370         psa = *V_ARRAYREF(var);
00371     else
00372         psa=V_ARRAY(var);
00373 
00374     dimCount = SafeArrayGetDim(psa);
00375 
00376     elementSize = SafeArrayGetElemsize (psa);
00377 
00378     elementType = V_VT(var) & VT_TYPEMASK;
00379 
00380     if (dimCount > 2)
00381         return (false);     /*to many dimensions, we only handle 1 for lists and 2 for records */
00382 
00383     hres = SafeArrayGetLBound(psa, 1, &lb1);
00384 
00385     if (FAILED(hres))
00386         return (false);     /* Failure here not good, but safe exit */
00387 
00388     hres = SafeArrayGetUBound(psa, 1, &ub1);
00389 
00390     if (FAILED(hres))
00391         return (false);     /* Failure here not good, but safe exit */
00392     
00393     if (dimCount == 2) {
00394         hres = SafeArrayGetLBound(psa, 2, &lb2);
00395 
00396         if (FAILED(hres))
00397             return (false);     /* Failure here not good, but safe exit */
00398 
00399         hres = SafeArrayGetUBound(psa, 2, &ub2);
00400 
00401         if (FAILED(hres))
00402             return (false);     /* Failure here not good, but safe exit */
00403 
00404         if ((ub2-lb2) != 1)
00405             return (false);     /*only support matrix of 2 by n */
00406         }
00407     else {
00408         lb2 = 0;
00409         ub2 = 0;
00410         }
00411 
00412     for (k = lb1; k <= ub1; k++) {
00413         index[0] = k;
00414         index[1] = lb2;
00415 
00416         if (! getArrayElement (elementType, psa, index, &val1))
00417             goto arrayerrorexit;
00418 
00419         if (dimCount == 2) {
00420             index[1] = lb2+1;
00421 
00422             if (! getArrayElement (elementType, psa, index, &val2)) {
00423                 disposevaluerecord (val1, false);
00424 
00425                 goto arrayerrorexit;
00426                 }
00427 
00428             if (htable == NULL) {
00429                 if (!langexternalnewvalue (idtableprocessor, nil, val)) {
00430                     disposevaluerecord (val1, false);
00431 
00432                     disposevaluerecord (val2, false);
00433 
00434                     goto arrayerrorexit;
00435                     }
00436                 
00437                 langexternalvaltotable (*val, &htable, HNoNode);
00438                 }
00439 
00440             if (htable != NULL)
00441                 if (! insertToTable (htable, &val1, &val2)) {
00442                     disposevaluerecord (val1, false);
00443 
00444                     disposevaluerecord (val2, false);
00445 
00446                     goto arrayerrorexit;  /*needs to cleanup*/
00447                     }
00448             }
00449         else {
00450             if (hlist == NULL) {
00451                 if (! opnewlist (&hlist, false)) {
00452                     disposevaluerecord (val1, false);
00453 
00454                     goto arrayerrorexit;
00455                     }
00456                 }
00457 
00458             if (hlist != NULL)
00459                 if (! insertToList (hlist, &val1)) {
00460                     disposevaluerecord (val1, false);
00461 
00462                     goto arrayerrorexit;  /*needs to cleanup*/
00463                     }
00464             }
00465         }
00466 
00467     if (dimCount == 2) {
00468 //          initvalue (val, tablevaluetype);
00469 //          val->data.binaryvalue = (Handle) htable;
00470         }
00471     else {
00472         initvalue (val, listvaluetype);
00473         val->data.listvalue = hlist;
00474         }
00475 
00476     //there is nothing to clean up here since everything is contained in the val record.
00477     return (true);
00478 
00479 arrayerrorexit:
00480     if (hlist != NULL)
00481         opdisposelist (hlist);
00482 
00483     if (htable != NULL)
00484         disposevaluerecord (*val, false);
00485 
00486     setnilvalue (val);      //safety
00487 
00488     return (false);
00489     } /*langwinipccoercearray*/
00490 
00491 
00492 static boolean langwinipccoerceparam (VARIANTARG * var, tyvaluerecord * val) {
00493     VARIANTARG var2;    /*used for conversion*/
00494     VARIANT var3;
00495     boolean res, fl;
00496     HRESULT hr;
00497 
00498     res = true;
00499 
00500     VariantInit (&var2);
00501     VariantInit (&var3);
00502 
00503     if ((V_ISBYREF (var)) && (! V_ISARRAY (var))) {
00504         fl = false;
00505 
00506         hr = VariantCopyInd (&var3, var);
00507 
00508         if (SUCCEEDED(hr)) {
00509             fl = langwinipccoerceparam ((VARIANTARG *)&var3, val);
00510 
00511             VariantClear (&var3);     /*we need to delete this copy */
00512             }
00513 
00514         return (fl);
00515         }
00516 
00517     if (V_ISVECTOR (var)) {
00518         return (false);
00519         }
00520 
00521     if (V_ISARRAY (var)) {
00522         return (langwinipccoercearray (var, val));
00523         }
00524 
00525     switch (V_VT(var) & VT_TYPEMASK) {
00526         case VT_EMPTY:
00527         case VT_NULL:
00528             setlongvalue (0, val);
00529             break;
00530 
00531         case VT_I2:
00532             setintvalue (V_I2(var), val);
00533             break;
00534 
00535         case VT_I4:
00536             setlongvalue (V_I4(var), val);
00537             break;
00538 
00539         case VT_R4:
00540             setsinglevalue (V_R4(var), val);
00541             break;
00542 
00543         case VT_R8:
00544             setdoublevalue (V_R8(var), val);
00545             break;
00546 
00547         case VT_BSTR:
00548             return (convertBSTRVariantToValue (var, val));
00549             break;
00550 
00551         case VT_BOOL:
00552             setbooleanvalue (V_BOOL(var), val);
00553             break;
00554 
00555         case VT_UI1:
00556             setcharvalue (V_UI1(var), val);
00557             break;
00558 
00559 
00560         case VT_DATE:
00561         case VT_CY:
00562             {
00563             hr = VariantChangeType (&var2, var, 0, VT_BSTR);
00564 
00565             if (SUCCEEDED(hr)) {
00566                 fl = convertBSTRVariantToValue (&var2, val);
00567 
00568                 VariantClear (&var2);  /*we need to delete this copy */
00569 
00570                 res = fl;
00571                 }
00572             else
00573                 res = false;
00574             break;
00575             }
00576 
00577         case VT_ERROR:
00578         case VT_DISPATCH:
00579         case VT_UNKNOWN:
00580         case VT_VARIANT:
00581         default:
00582             res = false;
00583         }
00584 
00585     return (res);
00586     } /*langwinipccoerceparam*/
00587 
00588 
00589 static boolean langwinipcbuildparamlist (hdltreenode hcode, DISPPARAMS* pDispParams, hdltreenode *hparams, unsigned int * errarg, boolean paramOrder) {
00590     
00591     /*
00592     take all of the parameters in the incoming verb hverb and build a code 
00593     tree for the corresponding lang paramter list
00594     
00595     2.1b5 dmb: special case for subroutine events
00596     
00597     2.1b12 dmb: push the root table to make sure address values will work
00598     
00599     3.0.1b2 dmb: for subroutine events, the direct parameter is optional
00600     
00601     5.0d14 dmb: take hcode parameter, so we can see of trap script takes 
00602     parameters by name. the first (direct) parameter can have any name. if
00603     all others are 4 characters long, and appear in the event, we use names.
00604     */
00605     
00606     register short i;
00607     long ctparams;
00608     hdltreenode hlist = nil;
00609     tyvaluerecord val;
00610     hdltreenode hparam;
00611     boolean flpushedroot;
00612 #ifdef SUPPORT_NAMED_PARAMS_IN_FRONTIER_COM
00613     boolean flnamedparams;
00614     byte bskey [6];
00615     tyvaluerecord vkey;
00616     hdltreenode hname, hnamelist;
00617     OSErr err;
00618 #endif
00619     register boolean fl = false;
00620     
00621     
00622     if (currenthashtable == nil)
00623         flpushedroot = pushhashtable (roottable);
00624     else
00625         flpushedroot = false;
00626     
00627     ctparams = pDispParams->cArgs;
00628     
00629     if (paramOrder == true) {  //use fixed foward order
00630         for (i = ctparams; i >= 1; i--) {
00631             
00632             if (!langwinipccoerceparam (&pDispParams->rgvarg[i-1], &val)) {
00633                 if (errarg != NULL)
00634                     *errarg = i;
00635 
00636                 goto exit;
00637                 }
00638 
00639             exemptfromtmpstack (&val); /*its data is about to belong to code tree*/
00640             
00641             if (!newconstnode (val, &hparam))
00642                 goto exit;
00643                         
00644             if (hlist == nil)
00645                 hlist = hparam;
00646             else
00647                 pushlastlink (hparam, hlist);
00648             } /*for*/
00649         }
00650     else {
00651         for (i = 1; i <= ctparams; i++) {
00652             if (!langwinipccoerceparam (&pDispParams->rgvarg[i-1], &val)) {
00653                 if (errarg != NULL)
00654                     *errarg = i;
00655 
00656                 goto exit;
00657                 }
00658 
00659             exemptfromtmpstack (&val); /*its data is about to belong to code tree*/
00660             
00661             if (!newconstnode (val, &hparam))
00662                 goto exit;
00663         
00664 #ifdef SUPPORT_NAMED_PARAMS_IN_FRONTIER_COM
00665 //          if (flnamedparams && i > 1) { // 5.0d14 dmb
00666 //          
00667 //              ostypetostring (param.key, bskey);
00668 //          
00669 //              if (!findnamedparam (hnamelist, bskey)) { // trap isn't expecting this param
00670 //              
00671 //                  langdisposetree (hparam);
00672 //              
00673 //                  continue;
00674 //                  }
00675 //          
00676 //              if (!setstringvalue (bskey, &vkey) || !newidnode (vkey, &hname)) {
00677 //              
00678 //                  langdisposetree (hparam);
00679 //              
00680 //                  goto exit;
00681 //                  }
00682 //          
00683 //              exemptfromtmpstack (&vkey);
00684 //          
00685 //              if (!pushbinaryoperation (fieldop, hname, hparam, &hparam))
00686 //                  goto exit;
00687 //              }   
00688 #endif
00689         
00690             if (hlist == nil)
00691                 hlist = hparam;
00692             else
00693                 pushlastlink (hparam, hlist);
00694             } /*for*/
00695         } /*else use parameter old backwards way*/
00696 
00697     fl = true;
00698     
00699     exit:
00700     
00701     if (flpushedroot)
00702         pophashtable ();
00703     
00704     if (fl)
00705         *hparams = hlist; /*nil if there weren't any params*/
00706     else
00707         langdisposetree (hlist); /*checks for nil*/
00708     
00709     return (fl);
00710     } /*langwinipcbuildparamlist*/
00711 
00712 #endif
00713 
00714 
00715 static boolean langwinipcprocessstarted (void) {
00716     
00717     /*
00718     we don't want Frontier's menus to dim when serving another application's 
00719     doscript or trap call.
00720     */
00721     
00722     processnotbusy ();
00723     
00724     return (true);
00725     } /*langwinipcprocessstarted*/
00726 
00727 
00728 static boolean langwinipcruncode (hdltreenode hcode, hdlhashtable hcontext, langerrormessagecallback errorcallback, tyvaluerecord * vreturned) {
00729     
00730     /*
00731     2.1b12 dmb: shared code between trap and doscript verbs.
00732     
00733     we always consume hcode
00734     
00735     2.1b14 dmb: take hcontext parameter for special kernel call case
00736     
00737     4.0b7 dmb: fixed double-dispose memory bug when
00738     */
00739     
00740     hdlprocessrecord hprocess;
00741     register boolean fl;
00742     
00743     if (!newprocess (hcode, true, nil, 0L, &hprocess)) {
00744         
00745         langdisposetree (hcode);
00746         
00747         return (false);
00748         }
00749         
00750     (**hprocess).processrefcon = (long) vreturned;
00751     
00752     if (errorcallback != NULL)
00753         (**hprocess).errormessagecallback = errorcallback;
00754     
00755     (**hprocess).processstartedroutine = &langwinipcprocessstarted;
00756     
00757     (**hprocess).hcontext = hcontext;
00758     
00759     fl = processruncode (hprocess, vreturned);
00760     
00761     disposeprocess (hprocess);
00762         
00763     return (fl);
00764     } /*langwinipcruncode*/
00765 
00766 
00767 #ifdef WIN95VERSION
00768 
00769 boolean langwinipchandleCOM (bigstring bsscriptname, void* pDispParams, tyvaluerecord * retval, boolean *flfoundhandler, unsigned int * errarg) {
00770     
00771     /*
00772     6.0a14 dmb: fixed potential memory leak in error case.
00773     */
00774 
00775     bigstring bsverb;
00776     register boolean fl = false;
00777     tyvaluerecord val;
00778     langerrormessagecallback savecallback;
00779     hdltreenode hfunctioncall;
00780     hdltreenode hparamlist;
00781     hdltreenode hcode;
00782     hdlhashtable htable;
00783     hdlhashtable hcontext = nil;
00784     tyvaluerecord vhandler;
00785     Handle hthread = nil;
00786     hdlhashnode handlernode;
00787     boolean paramOrder = false;
00788 
00789     *flfoundhandler = false;
00790     
00791     if (retval->data.longvalue == 1)
00792         paramOrder = true;                  //rab 9/3/98 fix for parameter order.
00793 
00794     disablelangerror();
00795 
00796     pushhashtable (roottable);
00797 
00798     fl = langexpandtodotparams (bsscriptname, &htable, bsverb);
00799 
00800     if (fl) {
00801     
00802         if (htable == nil)
00803             langsearchpathlookup (bsverb, &htable);
00804         }
00805     
00806     pophashtable();
00807     
00808     enablelangerror();
00809 
00810     if (! fl) {
00811         /*generate an error message*/
00812         return (false);
00813         }
00814 
00815     if (!hashtablelookupnode (htable, bsverb, &handlernode))
00816         return (false);
00817     
00818     vhandler = (**handlernode).val;
00819     
00820     *flfoundhandler = true;
00821             
00822     /*build a code tree and call the handler, with our error hook in place*/
00823     
00824     langwinipchookerrors (&savecallback);
00825     
00826     hcode = nil;
00827     
00828     if ((**htable).valueroutine == nil) { /*not a kernel table*/
00829         
00830         if (!langexternalvaltocode (vhandler, &hcode))
00831             goto exit;
00832         
00833         if (hcode == nil) { /*needs compilation*/
00834             
00835             if (!langcompilescript (handlernode, &hcode))
00836                 goto exit;
00837             }
00838         }
00839     
00840 //  if (iskernelverb (hv)) { /*special case -- kernel verb specifies context*/
00841 //      
00842 //      if (!landgetlongparam (hv, keycurrenttable, (long *) &hcontext))
00843 //          goto exit;
00844 //      }
00845     
00846     setaddressvalue (htable, bsverb, &val);
00847     
00848     if (!pushfunctionreference (val, &hfunctioncall))
00849         goto exit;
00850     
00851 //  if (hcontext != nil)
00852 //      pushhashtable (hcontext);
00853     
00854     fl = langwinipcbuildparamlist (hcode,  (DISPPARAMS*)pDispParams, &hparamlist, errarg, paramOrder);
00855     
00856 //  if (hcontext != nil)
00857 //      pophashtable ();
00858     
00859     if (!fl) {
00860         setlongvalue ((long) ResultFromScode(DISP_E_TYPEMISMATCH), retval);
00861 
00862         langdisposetree (hfunctioncall);
00863         
00864         goto exit;
00865         }
00866     
00867     if (!pushfunctioncall (hfunctioncall, hparamlist, &hcode)) /*consumes input parameters*/
00868         goto exit;
00869     
00870     if (!pushbinaryoperation (moduleop, hcode, nil, &hcode)) /*needs this level*/
00871         goto exit;
00872     
00873     fl = langwinipcruncode (hcode, hcontext, langwinipcerrorroutine, retval);
00874     
00875     exit:
00876     
00877     langwinipcunhookerrors (savecallback);
00878     
00879     return (fl);
00880     } /*langwinipchandleCOM*/
00881 
00882 #endif
00883 
00884 
00885 static boolean
00886 langkernelbuildparamlist (
00887         hdltreenode      hcode,
00888         tyvaluerecord   *listval,
00889         hdltreenode     *hparams,
00890         unsigned int    *errarg)
00891 {
00892 #pragma unused (hcode)
00893     
00894     /*
00895     take all of the parameters in the incoming verb hverb and build a code 
00896     tree for the corresponding lang paramter list
00897     
00898     2.1b5 dmb: special case for subroutine events
00899     
00900     2.1b12 dmb: push the root table to make sure address values will work
00901     
00902     3.0.1b2 dmb: for subroutine events, the direct parameter is optional
00903     
00904     5.0d14 dmb: take hcode parameter, so we can see of trap script takes 
00905     parameters by name. the first (direct) parameter can have any name. if
00906     all others are 4 characters long, and appear in the event, we use names.
00907     */
00908     
00909     register short i;
00910     long ctparams;
00911     hdltreenode hlist = nil;
00912     tyvaluerecord val;
00913     hdltreenode hparam;
00914     boolean flpushedroot;
00915 #ifdef SUPPORT_NAMED_PARAMS_IN_FRONTIER_COM
00916     boolean flnamedparams;
00917     byte bskey [6];
00918     tyvaluerecord vkey;
00919     hdltreenode hname, hnamelist;
00920     OSErr err;
00921 #endif
00922     register boolean fl = false;
00923     
00924     if (currenthashtable == nil)
00925         flpushedroot = pushhashtable (roottable);
00926     else
00927         flpushedroot = false;
00928     
00929     if (!langgetlistsize (listval, &ctparams))
00930         goto exit;
00931     
00932     for (i = 1; i <= ctparams; i++) {
00933 
00934         if (!langgetlistitem (listval, i, NULL, &val)) {
00935 
00936             if (errarg != NULL)
00937                 *errarg = i;
00938 
00939             goto exit;
00940             }
00941 
00942         exemptfromtmpstack (&val); /*its data is about to belong to code tree*/
00943         
00944         if (!newconstnode (val, &hparam))
00945             goto exit;
00946         
00947 #ifdef SUPPORT_NAMED_PARAMS_IN_FRONTIER_COM
00948 //      if (flnamedparams && i > 1) { // 5.0d14 dmb
00949 //          
00950 //          ostypetostring (param.key, bskey);
00951 //          
00952 //          if (!findnamedparam (hnamelist, bskey)) { // trap isn't expecting this param
00953 //              
00954 //              langdisposetree (hparam);
00955 //              
00956 //              continue;
00957 //              }
00958 //          
00959 //          if (!setstringvalue (bskey, &vkey) || !newidnode (vkey, &hname)) {
00960 //              
00961 //              langdisposetree (hparam);
00962 //              
00963 //              goto exit;
00964 //              }
00965 //          
00966 //          exemptfromtmpstack (&vkey);
00967 //          
00968 //          if (!pushbinaryoperation (fieldop, hname, hparam, &hparam))
00969 //              goto exit;
00970 //          }
00971 #endif
00972         
00973         if (hlist == nil)
00974             hlist = hparam;
00975         else
00976             pushlastlink (hparam, hlist);
00977         } /*for*/
00978     
00979     fl = true;
00980     
00981     exit:
00982     
00983     if (flpushedroot)
00984         pophashtable ();
00985     
00986     if (fl)
00987         *hparams = hlist; /*nil if there weren't any params*/
00988     else
00989         langdisposetree (hlist); /*checks for nil*/
00990     
00991     return (fl);
00992     } /*langkernelbuildparamlist*/
00993 
00994 
00995 boolean langipcrunscript (bigstring bsscriptname, tyvaluerecord *vparams, hdlhashtable hcontext, tyvaluerecord *vreturned) {
00996     
00997     /*
00998     5.0.2b6 rab/dmb: new verb
00999     
01000     5.0.2b7 dmb: preserve errormessagecallback through the call
01001 
01002     6.0a14 dmb: fixed potential memory leak in error case.
01003     */
01004     
01005     bigstring bsverb;
01006     register boolean fl = false;
01007     tyvaluerecord val;
01008     hdltreenode hfunctioncall;
01009     hdltreenode hparamlist;
01010     hdltreenode hcode;
01011     hdlhashtable htable;
01012     tyvaluerecord vhandler;
01013     hdlhashnode handlernode;
01014     
01015     pushhashtable (roottable);
01016 
01017     fl = langexpandtodotparams (bsscriptname, &htable, bsverb);
01018 
01019     if (fl) {
01020     
01021         if (htable == nil)
01022             langsearchpathlookup (bsverb, &htable);
01023         }
01024     
01025     pophashtable();
01026 
01027     if (! fl)
01028         return (false);
01029     
01030     if (!hashtablelookupnode (htable, bsverb, &handlernode)) {
01031         
01032         langparamerror (unknownfunctionerror, bsverb);
01033         
01034         return (false);
01035         }
01036     
01037     vhandler = (**handlernode).val;
01038     
01039     /*build a code tree and call the handler, with our error hook in place*/
01040     
01041     hcode = nil;
01042     
01043     if ((**htable).valueroutine == nil) { /*not a kernel table*/
01044         
01045         if (!langexternalvaltocode (vhandler, &hcode)) {
01046 
01047             langparamerror (notfunctionerror, bsverb);
01048 
01049             goto exit;
01050             }
01051         
01052         if (hcode == nil) { /*needs compilation*/
01053             
01054             if (!langcompilescript (handlernode, &hcode))
01055                 goto exit;
01056             }
01057         }
01058         
01059     setaddressvalue (htable, bsverb, &val);
01060     
01061     if (!pushfunctionreference (val, &hfunctioncall))
01062         goto exit;
01063     
01064     if (hcontext != nil)
01065         pushhashtable (hcontext);
01066     
01067     fl = langkernelbuildparamlist (hcode, vparams, &hparamlist, NULL);
01068     
01069     if (hcontext != nil)
01070         pophashtable ();
01071     
01072     if (!fl) {
01073         
01074         setstringvalue (BIGSTRING ("0x31" "Can't complete call because of a parameter error."), vreturned);
01075         
01076         langdisposetree (hfunctioncall);
01077         
01078         goto exit;
01079         }
01080     
01081     if (!pushfunctioncall (hfunctioncall, hparamlist, &hcode)) /*consumes input parameters*/
01082         goto exit;
01083     
01084     if (!pushbinaryoperation (moduleop, hcode, nil, &hcode)) /*needs this level*/
01085         goto exit;
01086     
01087     fl = langwinipcruncode (hcode, hcontext, langcallbacks.errormessagecallback, vreturned);
01088     
01089     if (fl)
01090         pushvalueontmpstack (vreturned);
01091     
01092     exit:
01093     
01094     return (fl);
01095     } /*langipcrunscript*/

Generated on Wed May 31 18:19:54 2006 for frontierkernel 10.1.10a by  doxygen 1.4.6