/* <Scol Technologies License> */
/* 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 */
/* users part */

var USER_global=1;;
var USER_client=2;;
var USER_changeClass=1;;
var USER_changeParam=2;;
var USER_changeAll=3;;


/* global users list */
typeof globalUser=[User r1];;

/* user part */

fun treeNew(rights,commut)=treeVisibility mkVTree [commut rights];;

fun extrVisi(visi)=
 let strextr visi ->l in
 let hd hd l->type in
 if !strcmp type "T" then treeNew tl hd l atoi hd hd tl l
 else nil;;

var guestnb=0;;
fun _DMSgetNewId()= set guestnb=guestnb-1;;

fun uclassbyclass(z,c)=let z->[_ n] in !strcmp c n;;
fun uclassbydmi(z,d)=let z->[uc _] in uc==d;;
fun uibyu(ui,u)=ui.userUI==u;;
fun uibyid(ui,id)=ui.userUI.idU==id;;
fun ubyid(u,id)=u.idU==id;;
fun msgbyname(a,b)=let a->[x _] in !strcmp x b;;

fun UgetId(u)=u.idU;;
fun UgetFlag(u)=u.flagU;;

fun Ulist(d)=d.ulistDMI;;
fun UgetUser(ui)=ui.userUI;;
fun UgetUserI(d,u)=search_in_list d.ulistDMI @uibyu u;;
fun UgetUserIid(d,id)=search_in_list d.ulistDMI @uibyid id;;
fun UgetLocation(ui)=ui.locUI;;
fun UgetClass(ui)=ui.classUI;;
fun UgetParams(ui)=ui.paramUI;;
fun UgetParam(ui,n)=getInfos ui.paramUI n;;
fun UgetVisibility(ui)=ui.visiUI;;
fun UgetRights(ui)=match ui.visiUI with (treeVisibility x -> x.rightsVT);;


fun UcreateUser()= mkUser[_DMSgetNewId 0];;

fun UcreateGlobalUser(i,flag)=
 let search_in_list globalUser @ubyid i -> u in
 if u==nil then let mkUser[i flag] -> newu in
 (set globalUser=newu::globalUser;
  newu)
 else u;;

/* user instance creation */
fun UcreateUI2(d,u,class,param,visi,cbdel,cbcomm)=
 let mkUserI [u class param d cbdel cbcomm nil nil visi nil nil nil] -> ui in
 (set d.ulistDMI=ui::d.ulistDMI;
  let search_in_list d.uclassDMI @uclassbyclass class ->[uc _] in
  if uc==nil then nil
  else
  (set ui.uclassUI=uc;
   set uc.ulistDMI=ui::uc.ulistDMI;
   execch uc.chnDMI uc.cbUcreateDMI [ui]);
  ui);;

fun Ucreate(d,u,class,param,cbdel,cbcomm)=
 if u.flagU&USER_global || nil!=UgetUserI d u then nil
 else UcreateUI2 d u class param (treeNew nil 1) cbdel cbcomm;;

fun UcreateUI(d,u,class,param)=
 Ucreate d u class param nil nil;;

fun UcreateExt(i,id,flag,class,param,visi)=
 let _DMSgetByHandle i->d in
 if d==nil then nil
 else let UcreateGlobalUser id flag->u in
 let UcreateUI2 d u class param extrVisi visi nil nil -> ui in
 (execch d.chnDMI d.cbUcreateDMI [ui];
  ui);;

/* user instance destruction */
fun Udeletebis(ui)=
 set ui.locUI.ulistDMI=remove_from_list ui.locUI.ulistDMI ui;
 execch ui.locUI.chnDMI ui.cbDeleteUI [ui];
 set ui.locUI=nil;
 set ui.uclassUI.ulistDMI=remove_from_list ui.uclassUI.ulistDMI ui;
 execch ui.uclassUI.chnDMI ui.cbClassDeleteUI [ui];
 set ui.uclassUI=nil;
 0;;

fun Udelete(ui)=
 if ui.userUI.flagU&USER_global then nil
 else Udeletebis ui;;

fun UdeleteExt(i,id)=
 let UgetUserIid (_DMSgetByHandle i) id -> ui in
 if ui==nil then nil
 else Udeletebis ui;;

fun UdeleteDMIbis(ui,d)=
 set ui.uclassUI.ulistDMI=remove_from_list ui.uclassUI.ulistDMI ui;
 if d!=ui.uclassUI then execch ui.uclassUI.chnDMI ui.cbClassDeleteUI [ui]
 else nil;
 set ui.uclassUI=nil;
 0;;
 
fun UdeleteDMI(d)=apply_on_list d.ulistDMI @UdeleteDMIbis d;;

/* class and parameter changes notifications */
fun UChgClassbis(ui,class,param)=
 execch ui.uclassUI.chnDMI ui.cbClassDeleteUI [ui];
 set ui.uclassUI.ulistDMI=remove_from_list ui.uclassUI.ulistDMI ui;
 set ui.uclassUI=nil;
    
 set ui.classUI=class;
 set ui.paramUI=param;
 let search_in_list ui.locUI.uclassDMI @uclassbyclass class ->[uc _] in
 if uc==nil then nil
 else
 (set ui.uclassUI=uc;
  set uc.ulistDMI=ui::uc.ulistDMI;
  execch uc.chnDMI uc.cbUcreateDMI [ui]);
 execch ui.locUI.chnDMI ui.cbChgUI [ui USER_changeAll nil];
 ui;;

fun UchgClass(ui,class,param)=
 if ui.userUI.flagU&USER_global then nil
 else UChgClassbis ui class param;;

fun UChgClassExt(i,id,class,param)=
 let UgetUserIid (_DMSgetByHandle i) id -> ui in
 if ui==nil then nil else UChgClassbis ui class param;;


fun UsetParamsbis(ui,r)=
 set ui.paramUI=r;
 execch ui.locUI.chnDMI ui.cbChgUI [ui USER_changeParam nil];
 r;;
fun UsetParams(ui,r)=
 if ui.userUI.flagU&USER_global then nil
 else UsetParamsbis ui r;;

fun UsetParamsExt(i,id,param)=
 let UgetUserIid (_DMSgetByHandle i) id -> ui in
 if ui==nil then nil else UsetParamsbis ui param;;

fun remress(l,r)=
 if l==nil then nil
 else let l->[v n] in
 let v->[a b] in if !strcmp a r then n
 else v::remress n r;;

fun UsetParambis(ui,r,v)=
 set ui.paramUI=
  if v==nil then remress ui.paramUI r
  else [r v]::remress ui.paramUI r;
 execch ui.locUI.chnDMI ui.cbChgUI [ui USER_changeParam r];
 v;;

fun UsetParam(ui,r,v)=
 if ui.userUI.flagU&USER_global then nil
 else UsetParambis ui r v;;

fun UsetParamExt(i,id,r,v)=
 let UgetUserIid (_DMSgetByHandle i) id -> ui in
 if ui==nil then nil else UsetParambis ui r v;;

/* callback definitions */
fun UcbDelete(ui,f)= set ui.cbDeleteUI=f; ui;;
fun UcbChanged(ui,f)= set ui.cbChgUI=f; ui;;
fun UcbCreate(d,f)= set d.cbUcreateDMI=f;;

fun UcbMessage(ui,l)= set ui.msgUI=conc l ui.msgUI; ui;;

fun UremoveMessage(ui,s)= set ui.msgUI=remove_from_list ui.msgUI search_in_list ui.msgUI @msgbyname s; ui;;

/* message management */
fun UsendMessage(ui,action,param)=
 _on_ nil CsendUI [_DMSgetHandle ui.locUI ui.userUI.idU action param];;

fun Ureceive(dst,id,ac,pr)=
 let _DMSgetByHandle dst -> d in
 let UgetUserIid d id -> ui in
 if ui==nil then nil
 else if d!=ui.locUI then execch ui.uclassUI.chnDMI ui.cbClassCommUI [ui ac pr]
 else
 (execch ui.locUI.chnDMI switchstr ui.msgUI ac [ui ac pr];
  if ui.cbCommUI!=nil then execch ui.locUI.chnDMI ui.cbCommUI [ui ac pr]
  else nil);;

/* ascendant compatibility */
fun startuclass(ui,z)=
 let z->[uc class] in
 if strcmp ui.classUI class then nil
 else
 (set ui.uclassUI=uc;
  set uc.ulistDMI=ui::uc.ulistDMI;
  execch uc.chnDMI uc.cbUcreateDMI [ui]);
 0;;

fun UsetUserClass(d,uc,class)=
 set d.uclassDMI=[uc class]::d.uclassDMI;
 apply_on_list d.ulistDMI @startuclass [uc class];
 class;;

fun UcbDel(d,ui,f)=
 if d==ui.locUI then UcbDelete ui f
 else (set ui.cbClassDeleteUI=f; ui);;

fun UcbComm(d,ui,f)=
 if d==ui.locUI then set ui.cbCommUI=f
 else set ui.cbClassCommUI=f;
 ui;;

fun UcbChange(d,ui,f)=UcbChanged ui f;;

fun Usend(d,ui,action,param)=
 if d==ui.locUI then execch ui.uclassUI.chnDMI ui.cbClassCommUI [ui action param]
 else execch ui.locUI.chnDMI ui.cbCommUI [ui action param];
 0;;

fun UsendSrv(d,ui,action,param)=
 _on_ nil CsendUI [d.numDMI ui.userUI.idU action param];;


/* external api */
fun __createUI(i,id,flag,class,param,visi)= UcreateExt i id flag class strextr param visi;;
fun __deleteUI(i,id)=UdeleteExt i id;;
fun __chgClassUI(i,id,class,param)=UChgClassExt i id class strextr param;;
fun __setParamsUI(i,id,param)=UsetParamsExt i id strextr param;;
fun __setParamUI(i,id,r,v)=UsetParamExt i id r hd strextr v;;
fun __sendUI(dst,id,ac,pr)=Ureceive dst id ac pr;;