/* */ /* Copyright (c) 2003, organization : Scol Technologies Association, owner : Sylvain Huet */ /* For conditions of distribution and use, see copyright notice in dms/l/license.txt */ /* or on 'www.scol-technologies.org' */ /* cDHDMS - mar 00 - by Sylvain HUET */ /* core part */ var DMSoff=0;; typeof DMSname=S;; typeof DMSlogin=S;; typeof DMSid=I;; typeof DMSenv=Env;; typeof DMSserver=Chn;; typeof DMSwin=ObjWin;; typeof DMSnbDmi=I;; typeof DMSdmi=tab DMI;; typeof DMSreconnect=S;; /* misc functions */ fun conc(p,q)=if p==nil then q else (hd p)::conc tl p q;; /* get values of a given field */ fun getInfo(l,s)=hd switchstr l s;; fun getInfos(l,s)=switchstr l s;; fun getConcInfos(l,s)= if l==nil then nil else let l->[[a b] nxt] in if !strcmp a s then conc b getConcInfos nxt s else getConcInfos nxt s;; fun swbystr(a,b)=let a->[x _] in !strcmp x b;; fun getSwitchStr(l,s)=search_in_list l @swbystr s;; fun swbyequ(a,b)=let a->[x _] in x==b;; fun getSwitch(l,x)=search_in_list l @swbyequ x;; /* return wether an element is in a list */ fun findList(l,a)= if l==nil then 0 else let l->[x n] in if a==x then 1 else findList n a;; /* return wether a string element is in a list */ fun strFindList(l,a)= if l==nil then 0 else let l->[x n] in if !strcmp a x then 1 else strFindList n a;; fun Tunder(s)=if strcmp s "_" then s else nil;; /* return path of a filename */ fun lastslash(s,i)= let strfind "/" s i ->j in if j==nil then i else lastslash s j+1;; fun _DMSgetpath(path)=substr path 0 lastslash path 0;; /* manage relativ paths (relativ files should start with ./ */ fun _DMSrelativpath(path,l)= if l==nil then nil else let l->[n nxt] in (if !strcmp substr n 0 2 "./" then strcat path substr n 2 strlen n else n)::_DMSrelativpath path nxt;; /* communication constructors */ defcom Cgoto=goto S;; /* message to scol engine */ defcom Clang=lang S;; /* define client language */ defcom Center=enter I I S S S;; /* entering site : activeX, version, versionname, trace, enter */ defcom Cping=ping;; defcom Csend=send I S;; /* send an intra-message */ defcom Cevent=event I S S S S I;; /* send an inter-message module event param rep ulist tag */ defcom CcliDel=cliDel I;; /* indicates that a client module destroyed itself */ defcom CsendUI=sendUI I I S S;; /* send message to a user instance : mod, ui, action, param */ defcom Cdeltag=deltag I;; /* a tag should be destroyed : id */ defcom Cfiretag=firetag I S S;; /* a tag should be fired : id, param, ulist */ defcom Chook=hook I I S I;; /* send a hook inactive message : numfrom, nummod, action, id */ defcom Cdestroyed=destroyed;; /* send a message to the activeX container */ /* script constructors */ defcom SIniDMI=IniDMI S;; defcom Sreg=reg I;; defcom Sregch=regch;; defcom Sload=_load S;; /* proto */ proto _DMSgetByHandle=fun[I] DMI;; proto errHTTP=fun[S] I;; proto _COMurlDownload=fun[DMI S S] S;; proto _on_=fun[u0 Comm] I;; proto _upload_=fun[DMI S S fun[I] I] I;; proto _DOCremoveDmiDoc=fun[DMI] I;; proto UcreateGlobalUser=fun[I I] User;; proto UdeleteDMI=fun[DMI] I;; proto _DMSrootModule=fun[] DMI;; proto _DMSdelete=fun[DMI] I;; proto _loc=fun[DMI S [S r1]] S;; proto _BARupdate=fun[I I] I;; /* http functions */ var h8="00000000";; var h4="0000";; fun itoh8(i)= let itoh i -> s in strcat substr h8 0 8-strlen s s;; fun itoh4(i)= let itoh i -> s in strcat substr h4 0 4-strlen s s;; /* time functions */ var timedelta=0;; var tickdelta=0;; fun _DMStime()=time+timedelta;; fun _DMStickcount()=_tickcount+tickdelta;; fun _DMSsettime(tim,tick)= set timedelta=tim-time; set tickdelta=tick-_tickcount;; /* sound functions */ typeof DMSds=DS;; fun DMSinitDirectSound(a,b,c,f)= if DMSds==nil then set DMSds = execch DMSserver @_InitDirectSound [a b c f DMSwin] else DMSds;; fun DMSrelease()= if DMSds==nil then nil else _ReleaseDirectSound DMSds; set DMSds=nil;; /* end function */ var firstfatal=1;; defcom maincom=main S I S;; fun exitgracefully()= _DMSdelete _DMSrootModule; DMSrelease; 0;; fun _endE(a,b,r)= set DMSoff=1; exitgracefully; if r then (_openchannel nil strcat "_load \"locked/stduser.pkg\"\n" mkscript maincom [let _getress "firsturl" -> url in if url==nil then DMSreconnect else url nil nil] nil; _killchannel DMSserver; 0) else _closemachine;; fun _fatalError(title,msg)= if firstfatal then (_DLGrflmessage _DLGMessageBox DMSserver DMSwin title strcat msg _loc _DMSrootModule "RETRY_CNX" nil 2 @_endE 0; set firstfatal=0) else nil;; /* NewTimer */ struct NewTimer=[tTimer:Timer]mkMyTimer;; fun New_starttimer(chn,per)= mkMyTimer[_starttimer chn per];; fun New_rfltimer(t,f,x)= _rfltimer t.tTimer f x; t;; fun New_deltimer(t)= _deltimer t.tTimer;; /* structures */ typedef Pending= actionPending [DMI S S S [User r1] Tag] |msgPending S |hookPending I;; struct DMI= [numDMI:I,chnDMI:Chn,nameDMI:S,classDMI:S,stateDMI:I, sonsDMI:[DMI r1],fatherDMI:DMI, linkDMI:[[S I S S S] r1],eventsDMI:[S r1], paramDMI:S, zonesDMI:[[S r1] r1], beforecloseDMI: fun[] I, actionDMI:fun [DMI S S S] I, actionsDMI:[[S fun [DMI S S [User r1] Tag] I] r1], fifoDMI:[[Pending r1] [Pending r1]], controlDMI:[[S r1] r1],controlbufDMI:S,listDMI:[RSC r1],curDMI:RSC, ulistDMI:[UserI r1],uclassDMI:[[DMI S] r1],cbUcreateDMI:fun [UserI] I, locDMI:tab [[S S] r1],langDMI:S, neededDMI:[S r1],neededbufDMI:S,thmDMI:[[S r1] r1] ]mkDMI;; struct User= [idU:I,flagU:I]mkUser;; struct VTree=[commutVT:I,rightsVT:[S r1]] mkVTree;; typedef Visibility= treeVisibility VTree;; struct UserI= [userUI:User,classUI:S,paramUI:[[S r1]r1],locUI:DMI, cbDeleteUI:fun[UserI] I,cbCommUI:fun[UserI S S] I, msgUI:[[S fun[UserI S S] I] r1], cbChgUI:fun[UserI I S] I,visiUI:Visibility, uclassUI:DMI,cbClassDeleteUI:fun[UserI] I,cbClassCommUI:fun[UserI S S] I ]mkUserI;; /* tmp */ fun deltimerchn(x)=0;; fun DMSgetress(l,r)=getInfos l r;;