/* Dbadmn Client - DMS - dec 1999 by Patrice FAVRE */

typeof TxDb=ObjText;;
typeof TxUsr=ObjText;;
typeof TxPwd=ObjText;;
typeof Win=ObjWin;;
typeof BxTab=ObjBox;;
typeof CkAll=ObjCheck;;
typeof CkPack=ObjCheck;;
typeof TxPack=ObjText;;
typeof TxCurr=ObjText;;
typeof TxCount=ObjText;;
typeof LtTab=ObjListTab;;
typeof LtMenu=ObjMenu;;
typeof TxReq=ObjText;;
typeof CkShow=ObjCheck;;
typeof CkAutoOn=ObjCheck;;
typeof CkAutoOff=ObjCheck;;
typeof BtPup=ObjButton;;
typeof BtPdn=ObjButton;;
typeof BtCommit=ObjButton;;
typeof BtRollb=ObjButton;;
typeof TxLog=ObjText;;
typeof CkDebug=ObjCheck;;
typeof BmList=ObjBitmapList;;
typeof IxBlc=BitmapIndex;;
typeof IxMod=BitmapIndex;;
typeof IxSup=BitmapIndex;;
typeof IxIns=BitmapIndex;;
typeof IxCan=BitmapIndex;;
struct Col=[Cname:S, Ctyp:S, Clen:S, Ctxt:ObjText, Cval:ObjText] mkCol;;
typeof LstCols=[Col r1];;
typeof cpt=I;;
typeof CurTab=S;;
typeof CurSel=I;;
typeof CurPack=I;;
typeof delta=I;;
typeof BmMod=ObjBitmap;;
typeof BmSup=ObjBitmap;;
typeof BmIns=ObjBitmap;;
typeof BmCan=ObjBitmap;;
typeof BmBlc=ObjBitmap;;
typeof BmPup=ObjBitmap;;
typeof BmPdn=ObjBitmap;;
typeof MiMod=ObjMenuItem;;
typeof MiSup=ObjMenuItem;;
typeof MiIns=ObjMenuItem;;
typeof MiMfy=ObjMenuItem;;
typeof MiCan=ObjMenuItem;;
struct Sel=[Ix:BitmapIndex, Val:[S r1], Mod:[S r1]] mkSel;;
typeof LstSel=[Sel r1];;
var valnil="!!NIL!!";;
defcom CConnect=Connect S S S;;
defcom CAuto=Auto I;;
defcom CCommit=Commit;;
defcom CRollb=Rollb;;
defcom CGetTables=GetTables;;
defcom CGetCols=GetCols S;;
defcom CGetRows=GetRows I I;;
defcom CGetCount=GetCount S;;
defcom CModRow=ModRow S S;;
defcom CSupRow=SupRow S;;
defcom CInsRow=InsRow S;;
defcom CExeSql=ExeSql S I I I;;

/*-----------------------*/
fun conclst(p,q)=
	if p==nil then q
	else (hd p)::conclst (tl p) q
;;

/*-----------------------*/
fun complst(p,q,f)=
	if p==nil then
		if q==nil then exec f with [nil nil] else exec f with [nil hd q]
	else
		if q==nil then exec f with [hd p nil]
		else
			let p -> [hp np] in
			let q -> [hq nq] in
			let exec f with [hp hq] -> cmp in
				if cmp!=0 then cmp
				else complst np nq f
;;

/*-----------------------*/
fun cmpstr(a,b)=strcmp a b;;

/*-----------------------*/
fun _log(deb,key,par)=
	let _loc this key par -> m in (
		while (nth_char m (strlen m)-1)==10 do set m=substr m 0 (strlen m)-1;
		if !deb || (_GETcheck CkDebug)==1 then (
			_ADDtext TxLog strcat m "\n";
			_SCROLLtext TxLog 0 _GETlineCount TxLog;
			_DMSevent this "log" m nil
		)
		else nil;
		m
	)
;;

/*-----------------------*/
fun WResize(wn,u,w,h)=
	_POSITIONlistTab LtTab 5 55 w-10 175;
	_POSITIONtext TxLog 5 365 w-10 h-370
;;

/*-----------------------*/
fun WDestroy(wn,u)=
	_DSmenu LtMenu;
	_DSbitmap BmBlc;
	_DSbitmap BmMod;
	_DSbitmap BmSup;
	_DSbitmap BmIns;
	_DSbitmap BmCan;
	_DMSdelete this
;;

/*-----------------------*/
fun ZResize(c,z)=
	let c -> [_ x y w h] in (
		_SIZEwindow Win w h x y;
		WResize Win nil w h
	);
	0
;;

/*-----------------------*/
fun ZDestroy(z)=
	WDestroy nil nil
;;

/*-----------------------*/
fun EnPage()=
	let _GETcombo BxTab -> [_ tbl] in
		if (!strcmp CurTab tbl) && (_GETcheck CkPack) && (LstCols!=nil) then (
			if CurPack>1 then
				_ENbutton BtPup 1
			else
				_ENbutton BtPup 0;
			let sizelist LstSel -> nbsel in
			let atoi _GETtext TxCount -> count in
				if CurPack+nbsel > if count==0 then -1 else count then
					_ENbutton BtPdn 0
				else
					_ENbutton BtPdn 1
		)
		else (
			_ENbutton BtPup 0;
			_ENbutton BtPdn 0
		)
;;

/*-----------------------*/
fun Tcount(C,u,n,s)=
	if (strlen s)>0 then (
		_log 0 "L_GETCOUNT" s::nil;
		_DMSsend this CGetCount [s]
	)
	else nil
;;

/*-----------------------*/
fun Bconnect(B,wn)=
	let _GETtext TxDb -> db in
	let _GETtext TxUsr -> usr in
	let _GETtext TxPwd -> pwd in
		_DMSsend this CConnect [db usr pwd];
	_DSwindow wn
;;

/*-----------------------*/
fun Bselect(B,u)=
	let _GETcombo BxTab -> [_ tbl] in
		if (strlen tbl)<=0 then nil
		else (
			_log 0 "L_GETCOLS" tbl::nil;
			_DMSsend this CGetCols [tbl]
		)
;;

/*-----------------------*/
fun MajSel(sel,u)=
	if sel.Ix==IxMod then
		let strbuild sel.Mod::nil -> smod in (
			_log 1 "L_MODROW" smod::nil;
			_DMSsend this CModRow [strbuild sel.Val::nil smod]
		)
	else
	if sel.Ix==IxSup then
		let strbuild sel.Val::nil -> sval in (
			_log 1 "L_SUPROW" sval::nil;
			_DMSsend this CSupRow [sval]
		)
	else
	if sel.Ix==IxIns then
		let strbuild sel.Mod::nil -> smod in (
			_log 1 "L_INSROW" smod::nil;
			_DMSsend this CInsRow [smod]
		)
	else nil
;;

/*-----------------------*/
fun NextRows(cpk)=
	_RSTlistTab LtTab;
	set LstSel=nil;
	set cpt=0;
	_ENbutton BtPup 0;
	_ENbutton BtPdn 0;
	let _GETcheck CkAll -> all in
	let _GETtext TxReq -> req in
	let _GETcheck CkShow -> show in
		if all==1 then (
			_log 0 "L_GETAROWS" CurTab::nil;
			if (strlen req)<=0 || show!=1 then
				_DMSsend this CGetRows [cpk nil]
			else (
				_log 0 "L_EXESQL" nil;
				_log 1 "L_TXT" req::nil;
				_DMSsend this CExeSql [req show cpk nil]
			)
		)
		else
			let atoi _GETtext TxPack -> pack in (
				_log 0 "L_GETPROWS" (itoa pack)::(itoa cpk)::(itoa cpk+pack-1)::CurTab::nil;
				if (strlen req)<=0 || show!=1 then
					_DMSsend this CGetRows [cpk pack]
				else (
					_log 0 "L_EXESQL" nil;
					_log 1 "L_TXT" req::nil;
					_DMSsend this CExeSql [req show cpk pack]
				)
			)
;;

/*-----------------------*/
fun Bapply(B,u)=
	_log 0 "L_MAJTAB" CurTab::nil;
	apply_on_list LstSel @MajSel nil;
	_log 0 "L_DONE" nil;
	_RSTlistTab LtTab;
	set CurPack=1;
	set delta=0;
	set LstSel=nil;
	let _GETtext TxReq -> req in
	let _GETcheck CkShow -> show in (
		if show!=1 then (
			if (strlen req)<=0 then nil
			else (
				_log 0 "L_EXESQL" nil;
				_log 1 "L_TXT" req::nil;
				set cpt=0;
				_DMSsend this CExeSql [req show 1 nil]
			);
			Bselect nil nil
		)
		else NextRows 1
	)
;;

/*-----------------------*/
fun Bcommit(B,u)=
	_log 0 "L_COMMIT" nil;
	_DMSsend this CCommit []
;;

/*-----------------------*/
fun Brollb(B,u)=
	_log 0 "L_ROLLB" nil;
	_DMSsend this CRollb []
;;

/*-----------------------*/
fun Call(C,u,e)=
	_ENtext TxPack !e;
	EnPage
;;

/*-----------------------*/
fun Cpack(C,u,e)=
	_ENtext TxPack e;
	EnPage
;;

/*-----------------------*/
fun CautoOn(C,u,e)=
	_ENbutton BtCommit !e;
	_ENbutton BtRollb !e;
	_log 0 "L_AUTOON" nil;
	_DMSsend this CAuto [1]
;;

/*-----------------------*/
fun CautoOff(C,u,e)=
	_ENbutton BtCommit e;
	_ENbutton BtRollb e;
	_log 0 "L_AUTOOFF" nil;
	_DMSsend this CAuto [0]
;;

/*-----------------------*/
fun LshowMenu(L,u,i)=
	if i>=0 then (
		set CurSel=i;
		let nth_list LstSel i -> sel in (
			if sel.Ix!=IxIns then
				_SETtext TxCurr itoa (CurPack+CurSel)
			else nil;
			if (sel.Ix==IxBlc) || (sel.Ix==IxCan) then (
				_ENmenuItem MiMod;
				_ENmenuItem MiSup;
				_ENmenuItem MiIns;
				_DImenuItem MiMfy;
				_DImenuItem MiCan
			)
			else
			if (sel.Ix==IxMod) || (sel.Ix==IxIns) then (
				_DImenuItem MiMod;
				_DImenuItem MiSup;
				_ENmenuItem MiIns;
				_ENmenuItem MiMfy;
				_ENmenuItem MiCan
			)
			else
			if sel.Ix==IxSup then (
				_ENmenuItem MiMod;
				_DImenuItem MiSup;
				_ENmenuItem MiIns;
				_DImenuItem MiMfy;
				_ENmenuItem MiCan
			)
			else nil
		);
		_DRAWmenu Win LtMenu 100 100 PM_LEFT_ALIGN|PM_TOP_ALIGN
	)
	else nil
;;

/*-----------------------*/
fun Bpup(B,u)=
	let _GETtext TxPack -> pack in
	let CurPack-atoi pack -> cpk in (
		if cpk<1 then (
			set cpk=1;
			set delta=1-CurPack
		)
		else
			set delta=-1*atoi pack;
		NextRows cpk
	)
;;

/*-----------------------*/
fun Bpdn(B,u)=
	let sizelist LstSel -> nbsel in (
		set delta=nbsel;
		let CurPack+nbsel -> cpk in
			NextRows cpk
	)
;;

/*-----------------------*/
fun action(from,act,param,rep)=
	if !strcmp act "connect" then (
		if Win!=nil then (
			_DMSreleaseZone this "form";
			set Win=nil
		)
		else nil;
		let 200 -> w in
		let 120 -> h in
		let _GETwindowSizePosition DMSwin -> [dw dh dx dy] in
		let dx+(dw-w)/2 -> px in
		let dy+(dh-h)/2 -> py in
		let _CRwindow _channel DMSwin if px>=0 then px else nil if py>=0 then py else nil w h WN_MENU|WN_MINBOX "DBADMIN" -> wn in (
			_CRtext _channel wn 5 5 80 20 ET_ALIGN_RIGHT|ET_TABFOCUS _loc this "T_DSN" nil;
			set TxDb=_CReditLine _channel wn 85 5 w-90 20 ET_AHSCROLL|ET_DOWN "";
			_CRtext _channel wn 5 30 80 20 ET_ALIGN_RIGHT|ET_TABFOCUS _loc this "T_USR" nil;
			set TxUsr=_CReditLine _channel wn 85 30 w-90 20 ET_AHSCROLL|ET_DOWN "";
			_CRtext _channel wn 5 55 80 20 ET_ALIGN_RIGHT|ET_TABFOCUS _loc this "T_PWD" nil;
			set TxPwd=_CReditLine _channel wn 85 55 w-90 20 ET_PASSWORD|ET_AHSCROLL|ET_DOWN "";
			_CBbutton _CRbutton _channel wn w/2-35 h-25 70 20 0 _loc this "B_CONNECT" nil @Bconnect wn;
			nil
		)
	)
	else
	if !strcmp act "show" then (
		if Win==nil then
			let _DMSgetZone this "form" nil @ZResize @ZDestroy -> [wn x y w h] in (
  			if wn!=nil then
					set Win=_CRwindow _channel wn x y w h WN_CHILDINSIDE|WN_NOCAPTION|WN_NOBORDER ""
  			else (
			    set w=500;
    			set h=450;
			    set Win=_CRwindow _channel DMSwin nil nil w h WN_MENU|WN_MINBOX|WN_SIZEBOX "DBADMIN";
			    _CBwinSize Win @WResize nil;
			    _CBwinDestroy Win @WDestroy nil;
			    nil
				);
				_CRtext _channel Win 5 5 100 20 ET_ALIGN_LEFT _loc this "T_TABLE" nil;
				set BxTab=_CRcombo _channel Win 5 25 120 100 CB_NOEDIT|CB_AHSCROLL|CB_DOWN "";
				_CBcombo BxTab @Tcount nil;
				let _CRwindow _channel Win 150 0 w-150 25 WN_CHILDINSIDE|WN_NOCAPTION|WN_NOBORDER "" -> rad in (
					set CkAll=_CRcheck _channel rad 5 5 90 20 CH_RADIO _loc this "C_ALL" nil;
					set CkPack=_CRcheck _channel rad 95 5 100 20 CH_RADIO _loc this "C_PACK" nil;
					_CBcheck CkAll @Call nil;
					_CBcheck CkPack @Cpack nil;
					_SETcheck CkAll 1;
					set TxPack=_CReditLine _channel rad 200 5 30 20 ET_AHSCROLL|ET_DOWN|ET_NUMBER "50";
					_ENtext TxPack 0
				);
				_CBbutton _CRbutton _channel Win 170 30 80 20 0 _loc this "B_SELECT" nil @Bselect nil;
				set BtPup=_CBbutton _CRbuttonBitmap _channel Win BmPup 300 30 20 20 0 @Bpup nil;
				set TxCurr=_CRtext _channel Win 325 30 60 20 ET_ALIGN_RIGHT|ET_AHSCROLL|ET_DOWN "";
				set BtPdn=_CBbutton _CRbuttonBitmap _channel Win BmPdn 390 30 20 20 0 @Bpdn nil;
				_CRtext _channel Win 415 30 40 20 ET_ALIGN_RIGHT _loc this "T_OF" nil;
				set TxCount=_CRtext _channel Win 460 30 60 20 ET_ALIGN_RIGHT|ET_AHSCROLL|ET_DOWN "0";
				_ENbutton BtPup 0;
				_ENbutton BtPdn 0;
				set LtTab=_CRlistTab _channel Win 5 55 w-10 175 LV_DOWN|LV_SINGLESEL;
				_ADDlistTabColumn LtTab 0 20 ET_ALIGN_LEFT "";
				set LstSel=nil;
				set CurSel=nil;
				set CurTab=nil;
				set CurPack=0;
				set delta=0;
				_CRtext _channel Win 5 237 90 20 ET_ALIGN_LEFT _loc this "T_REQUEST" nil;
				set TxReq=_CReditText _channel Win 5 255 3*w/4 40 ET_ALIGN_LEFT|ET_VSCROLL|ET_DOWN "";
				set CkShow=_CRcheck _channel Win 3*w/4+15 270 w/4-20 20 0 _loc this "C_SHOW" nil;
				_CBbutton _CRbutton _channel Win 10 310 80 25 0 _loc this "B_APPLY" nil @Bapply nil;
				let _CRwindow _channel Win 150 295 w-150 50 WN_CHILDINSIDE|WN_NOCAPTION|WN_NOBORDER "" -> rad in (
					set CkAutoOn=_CRcheck _channel rad 5 5 150 20 CH_RADIO _loc this "C_AUTO_ON" nil;
					set CkAutoOff=_CRcheck _channel rad 5 25 150 20 CH_RADIO _loc this "C_AUTO_OFF" nil;
					_CBcheck CkAutoOff @CautoOff nil;
					_CBcheck CkAutoOn @CautoOn nil;
					_SETcheck CkAutoOn 1;
					set BtCommit=_CBbutton _CRbutton _channel rad 155 25 80 20 0 _loc this "B_COMMIT" nil @Bcommit nil;
					set BtRollb=_CBbutton _CRbutton _channel rad 250 25 80 20 0 _loc this "B_ROLLB" nil @Brollb nil;
					_ENbutton BtCommit 0;
					_ENbutton BtRollb 0
				);
				_CRtext _channel Win 5 345 50 20 ET_ALIGN_LEFT _loc this "T_LOG" nil;
				set CkDebug=_CRcheck _channel Win 60 345 200 20 0 _loc this "C_DEBUG" nil;
				set TxLog=_CRtext _channel Win 5 365 w-10 h-370 ET_ALIGN_LEFT|ET_VSCROLL|ET_DOWN "";
				_log 0 "L_START" nil;
				_log 0 "L_GETTABLES" nil;
				_DMSsend this CGetTables []
			)
		else nil;
		_DMSevent this "shown" nil nil
	)
  else
	if !strcmp act "hide" then (
		if Win!=nil then (
			_DMSreleaseZone this "form";
			set Win=nil
		)
		else nil;
		_DMSevent this "hidden" nil nil
	)
	else nil
;;

/*-----------------------*/
fun __RetConnect(res)=
	if res==1 then
		action nil "show" nil nil
	else
		action nil "connect" nil nil
;;

/*-----------------------*/
fun __SqlErr(stat,nat,msg,nb)=
	_log 0 "L_SQL" stat::(itoa nat)::(itoa nb)::msg::nil
;;

/*-----------------------*/
fun AddTable(t,u)=
	_ADDcombo BxTab 0 _log 1 "L_TXT" t
;;

/*-----------------------*/
fun __RetGetTables(s)=
	apply_on_list strextr s @AddTable nil;
	_log 0 "L_DONE" nil
;;

/*-----------------------*/
fun AddCol(c,u)=
	let u -> [col] in
	let c -> [n [t [l _]]] in (
		set LstCols=conclst LstCols (mkCol [n t l nil nil])::nil;
		_ADDlistTabColumn LtTab col 50 ET_ALIGN_LEFT n;
		mutate u <- [col+1]
	)
;;

/*-----------------------*/
fun __RetGetCols(s)=
	_log 1 "L_TXT" s::nil;
	_DSlistTab LtTab;
	set BmList=_CRbitmapList _channel 14 14;
	set IxBlc=_ADDbitmapList BmList BmBlc;
	set IxMod=_ADDbitmapList BmList BmMod;
	set IxSup=_ADDbitmapList BmList BmSup;
	set IxIns=_ADDbitmapList BmList BmIns;
	set IxCan=_ADDbitmapList BmList BmCan;
	let _GETwindowSizePosition Win -> [w _ _ _] in
		set LtTab=_CRlistTab _channel Win 5 55 w-10 175 LV_DOWN|LV_SINGLESEL;
	set LstSel=nil;
	_ADDlistTabColumn LtTab 0 20 ET_ALIGN_LEFT "";
	_SETlistTabBitmaps LtTab BmList;
	_CBlistTabSelect LtTab @LshowMenu nil;
	set LstCols=nil;
	apply_on_list strextr s @AddCol [1];
	_log 0 "L_DONE" nil;
	let _GETcombo BxTab -> [_ tbl] in
		set CurTab=tbl;
	_SETtext TxReq "";
	_SETcheck CkShow 0;
	set CurPack=1;
	set delta=0;
	NextRows CurPack
;;

/*-----------------------*/
fun AddRow(r,u)=
	let u -> [col] in (
		_SETlistTabItem LtTab cpt col if !strcmp r valnil then "" else r;
		mutate u <- [col+1]
	)
;;

/*-----------------------*/
fun __RetGetRow(s)=
	_log 1 "L_TXT" s::nil;
	_ADDlistTabItem LtTab cpt cpt "";
	_SETlistTabBitmap LtTab cpt IxBlc;
	let hd strextr s -> val in (
		apply_on_list val @AddRow [1];
		set LstSel=conclst LstSel (mkSel [IxBlc val nil])::nil
	);
	set cpt=cpt+1
;;

/*-----------------------*/
fun __RetGetCount(t,s)=
	_log 1 "L_TXT" s::nil;
	_SETtext TxCount s;
	_log 0 "L_DONE" nil;
	EnPage
;;

/*-----------------------*/
fun __RetDone()=
	_log 0 "L_DONE" nil
;;

/*-----------------------*/
fun __RetGetRows(s)=
	__RetDone;
	set CurPack=CurPack+delta;
	_SETtext TxCurr itoa CurPack;
	_SETtext TxCount s;
	EnPage
;;

/*-----------------------*/
fun __NoData()=
	__RetDone;
	set CurSel=nil;
	set CurPack=0;
	_SETtext TxCurr "0";
	EnPage;
	_DImenuItem MiMod;
	_DImenuItem MiSup;
	_ENmenuItem MiIns;
	_DImenuItem MiMfy;
	_DImenuItem MiCan;
	_DRAWmenu Win LtMenu 100 100 PM_LEFT_ALIGN|PM_TOP_ALIGN
;;

/*-----------------------*/
fun EcreEdt(C,u)=
	let u -> [wn w pos lst] in
	let lst -> [val nxt] in (
		set C.Ctxt=_CRtext _channel wn 5 pos w/3-10 20 ET_ALIGN_RIGHT C.Cname;
		set C.Cval=_CReditLine _channel wn w/3 pos 2*w/3-5 20 ET_AHSCROLL|ET_DOWN if !strcmp val valnil then "" else val;
		mutate u <- [_ _ pos+25 nxt]
	)
;;

/*-----------------------*/
fun ErszEdt(C,u)=
	let u -> [w pos] in (
		_POSITIONtext C.Ctxt 5 pos w/3-10 20;
		_POSITIONtext C.Cval w/3 pos 2*w/3-5 20;
		mutate u <- [_ pos+25]
	)
;;

/*-----------------------*/
fun EgetEdt(C,u)=
	let u -> [res] in
	let _GETtext C.Cval -> val in
		mutate u <- [conclst res (if (strlen val)<=0 then valnil else val)::nil]
;;

/*-----------------------*/
fun EResize(wn,u,w,h)=
	let u -> [Pwn Cwn bok bcan] in (
		_POSITIONwindowEx Pwn 5 5 w-10 h-35;
		_POSITIONwindow Cwn 0 0 w-25 (sizelist LstCols)*25+5;
		_POSITIONbutton bok w/2-90 h-25 70 20;
		_POSITIONbutton bcan w/2+20 h-25 70 20;
		apply_on_list LstCols @ErszEdt [w-25 5]
	)
;;

/*-----------------------*/
fun ECancel(B,u)=
	let u -> [wn fct res] in (
		_DSwindow wn;
		_ENwindow Win 1;
		_TOPwindow Win;
		exec fct with [res]
	)
;;

/*-----------------------*/
fun EOk(B,u)=
	let u -> [wn fct inival] in
	let [nil] -> r in (
		apply_on_list LstCols @EgetEdt r;
		let r -> [res] in
			if (complst inival res @cmpstr)==0 then
				ECancel B [wn fct nil]
			else
				ECancel B [wn fct res]
	)
;;

/*-----------------------*/
fun EditSel(inival,fct)=
	_ENwindow Win 0;
	let 200 -> w in
	let 300 -> h in
	let _CRwindow _channel Win 20 20 w h WN_SIZEBOX _loc this "T_EDIT" nil -> EWin in (
		let _CRscrollWindow _channel EWin 5 5 w-10 h-35 w-25 (sizelist LstCols)*25+5
		                    WN_CHILDINSIDE|WN_NOCAPTION|WN_NOBORDER|WN_VSCROLL "" -> [PWin CWin] in
		let _CRbutton _channel EWin w/2-90 h-25 70 20 0 _loc this "B_OK" nil -> bok in
		let _CRbutton _channel EWin w/2+20 h-25 70 20 0 _loc this "B_CANCEL" nil -> bcan in (
			apply_on_list LstCols @EcreEdt [CWin w-25 5 inival];
			_CBwinSize EWin @EResize [PWin CWin bok bcan];
			_CBbutton bcan @ECancel [EWin fct nil];
			_CBbutton bok @EOk [EWin fct inival]
		)
	)
;;

/*-----------------------*/
fun MretEdt(res,Mi)=
	if res!=nil then
		let nth_list LstSel CurSel -> sel in
			if Mi==MiMod then (
				set sel.Ix=IxMod;
				_SETlistTabBitmap LtTab CurSel IxMod;
				set sel.Mod=res;
				set cpt=CurSel;
				apply_on_list res @AddRow [1]
			)
			else
			if Mi==MiIns then
				let sizelist LstSel -> nbsel in (
					_ADDlistTabItem LtTab nbsel nbsel "";
					set LstSel=conclst LstSel (mkSel [IxIns nil res])::nil;
					_SETlistTabBitmap LtTab nbsel IxIns;
					set cpt=nbsel;
					apply_on_list res @AddRow [1]
				)
			else
			if Mi==MiMfy then (
				set sel.Mod=res;
				set cpt=CurSel;
				apply_on_list res @AddRow [1]
			)
			else nil
	else nil
;;

/*-----------------------*/
fun MChoice(Mi,u)=
	let nth_list LstSel CurSel -> sel in
		if Mi==MiMod then (
			EditSel sel.Val mknode @MretEdt Mi;
			nil
		)
		else
		if Mi==MiSup then (
			set sel.Ix=IxSup;
			_SETlistTabBitmap LtTab CurSel IxSup
		)
		else
		if Mi==MiIns then (
			EditSel nil mknode @MretEdt Mi;
			nil
		)
		else
		if Mi==MiMfy then (
			EditSel sel.Mod mknode @MretEdt Mi;
			nil
		)
		else
		if Mi==MiCan then
			if sel.Ix==IxMod then (
				set cpt=CurSel;
				apply_on_list sel.Val @AddRow [1];
				set sel.Mod=nil;
				set sel.Ix=IxCan;
				_SETlistTabBitmap LtTab CurSel IxCan
			)
			else
			if sel.Ix==IxSup then (
				set sel.Ix=IxCan;
				_SETlistTabBitmap LtTab CurSel IxCan
			)
			else
			if sel.Ix==IxIns then (
				set LstSel=remove_from_list LstSel sel;
				_DELlistTabItem LtTab CurSel
			)
			else nil
		else nil
;;

/*-----------------------*/
fun IniDMI(p)=
	set BmBlc=_LDbitmap _channel _checkpack "dms/db/dbadmin/blc.bmp";
	set BmMod=_LDbitmap _channel _checkpack "dms/db/dbadmin/mod.bmp";
	set BmSup=_LDbitmap _channel _checkpack "dms/db/dbadmin/sup.bmp";
	set BmIns=_LDbitmap _channel _checkpack "dms/db/dbadmin/ins.bmp";
	set BmCan=_LDbitmap _channel _checkpack "dms/db/dbadmin/can.bmp";
	set BmPup=_LDbitmap _channel _checkpack "dms/db/dbadmin/pageup.bmp";
	set BmPdn=_LDbitmap _channel _checkpack "dms/db/dbadmin/pagedown.bmp";
	set LtMenu=_CRpopupMenu _channel;
	set MiMod=_APPitem _channel LtMenu ME_ENABLED "UPDATE";
	set MiSup=_APPitem _channel LtMenu ME_ENABLED "DELETE";
	set MiIns=_APPitem _channel LtMenu ME_ENABLED "INSERT";
	_APPitem _channel LtMenu ME_SEPARATOR "";
	set MiMfy=_APPitem _channel LtMenu ME_ENABLED _loc this "M_MFY" nil;
	set MiCan=_APPitem _channel LtMenu ME_ENABLED _loc this "M_UNDO" nil;
	_SETmenuItemBitmaps MiMod BmMod BmMod;
	_SETmenuItemBitmaps MiSup BmSup BmSup;
	_SETmenuItemBitmaps MiIns BmIns BmIns;
	_SETmenuItemBitmaps MiCan BmCan BmCan;
	_CBmenu MiMod @MChoice nil;
	_CBmenu MiSup @MChoice nil;
	_CBmenu MiIns @MChoice nil;
	_CBmenu MiMfy @MChoice nil;
	_CBmenu MiCan @MChoice nil;
	_DMSregisterDMI this @action nil;
	action nil "connect" nil nil;
	_DMSevent this "in" nil nil
;;