/******************************************************************************* Module Mailinglist Client part Version: 1.0 Authors: Catheline VEILLEUX, Laurent PLUMAT Last update: 18/09/2001 Mailinglist Module *******************************************************************************/ struct TIadmin = [ A_interface : ObjWin, /* admin interface */ A_listeML : ObjList, /* Liste of mailinglist */ A_theme : ObjText, /* theme of the mailinglist */ A_pseudo : ObjText, /* login to add */ A_RlistLogin : ObjList, /* list of login who receive mail */ A_PlistLogin : ObjList, /* list of login who send mail */ A_Tpost : ObjButton, /* delete login in post list */ A_Treceive : ObjButton, /* delete login in send list */ A_Apost : ObjButton, /* add a login in the post list */ A_Areceive : ObjButton, /* add a login in the receive list */ A_Wpost : ObjWin, A_Wreceive : ObjWin, A_CPupost : ObjCheck, /* check to know kind of post */ A_CPrpost : ObjCheck, A_CPureceive : ObjCheck, /* check to know kind of receive */ A_CPrreceive : ObjCheck, A_Tmailing : ObjButton, /* delete a mailinglist */ A_Amailing : ObjButton, /* add a mailinglist */ A_newML : ObjText, /* field to write the name of a new mailinglist */ A_TypeReceive : S, /* public or private */ A_TypePost : S, /* public or private */ A_valider : ObjButton, /* button to validate mailinglist modification */ A_BMPcorbeille : ObjBitmap /* bitmap of the trash */ ]mkIadmin;; struct TIuser = [ U_interface : ObjWin, /* user interface */ U_listofSName : ObjList, /* list of subcribe mailinglist */ U_themeML : ObjText, /* theme of the select mailinglist */ U_themeSML : ObjText, /* theme of the select mailinglist on the serveur*/ U_listofName : ObjList, /* list of mailinglist */ U_btnSub : ObjButton, /* subscribe to a mailing list */ U_normalMail : ObjCheck, /* check to choose normal send of mail */ U_noMail : ObjCheck, /* check to chosse nomail send */ U_sendSujet : ObjText, /* subjet of the mail */ U_sendBody : ObjText, /* body of the mail */ U_btnSendMail : ObjButton, /* send mail button */ U_Sinterface : ObjWin, /* window to subscribe */ U_Tmailing : ObjButton, /* button to unsubscribe */ U_bodySize : ObjText, /* size of the text in the body */ U_subscribe : ObjButton /* button to lauch subscribe interface */ ] mkIuser;; typeof CreationML = TcreationML;; typeof Iuser = TIuser;; typeof Iadmin = TIadmin;; /*******************************************************************************************/ /* variable global */ /*******************************************************************************************/ typeof width = I;; typeof height = I;; typeof listML = [[S S] r1];; /*path*/ typeof modulePath = S;; /********************************************************************************************/ /* defcom */ /********************************************************************************************/ defcom SAddML = AddML S I;; /* add or modifie a mailinglist */ defcom SRequestID = RequestID S I;; /* Check if an login is in the database */ defcom SListML = ListML I;; /* Ask for the list of mailinglist */ defcom SdeleteML = deleteML S;; /* Delete a mailinglist */ defcom SsendML = sendML S;; /* ask for à mailinglist */ defcom Ssubscribe = subscribe S I;; /* ask ti subscribe or unsubscribe to a mailinglist */ defcom Sreception = reception S I;; /* change reception type */ defcom SsendMail = sendMail S S S;; /* send a mail to a mailinglist */ defcom ScloseAdmin = closeAdmin;; /* close admin window */ defcom ScheckMail = checkMail;; /* check if the mail is in the database */ /******************************************************************************************* erase all data in the creation and modification form ********************************************************************************************/ fun eraseAll () = _SETtext Iadmin.A_theme ""; _ENtext Iadmin.A_theme 0; _SETtext Iadmin.A_pseudo ""; _SETcheck Iadmin.A_CPureceive 1; _SETcheck Iadmin.A_CPrreceive 0; _SETcheck Iadmin.A_CPupost 1; _SETcheck Iadmin.A_CPrpost 0; _ENcheck Iadmin.A_CPureceive 0; _ENcheck Iadmin.A_CPrreceive 0; _SHOWlist Iadmin.A_RlistLogin WINDOW_HIDDEN; _SHOWbutton Iadmin.A_Treceive WINDOW_HIDDEN; _SHOWbutton Iadmin.A_Areceive WINDOW_HIDDEN; _ENcheck Iadmin.A_CPupost 0; _ENcheck Iadmin.A_CPrpost 0; _SHOWbutton Iadmin.A_Tpost WINDOW_HIDDEN; _SHOWbutton Iadmin.A_Apost WINDOW_HIDDEN; _SHOWlist Iadmin.A_PlistLogin WINDOW_HIDDEN; _ENtext Iadmin.A_pseudo 0; _ENbutton Iadmin.A_valider 0; _RSTlist Iadmin.A_RlistLogin; _RSTlist Iadmin.A_PlistLogin; 0 ;; /****************************************************************************** fill the list of login when receive a mailinglist list -> ObjList : list to fill login -> S : login to put in the list *******************************************************************************/ fun cbFillList (login, list) = _ADDlist list 0 login ;; /******************************************************************************************* fonction qui verifie si le pseudo entre par l'admin est bien dans la base de donnees si non (index =0 ou 2) : envoie un message d'erreur si oui (index =1) : rien a part initialiser currentPseudo à 1 ********************************************************************************************/ fun __ResponseRequestID (pseudo, index) = let _loc this "SEARCH_SUSCRIBER" nil -> titleMessage in if index == 0 then ( _DLGMessageBox _channel nil titleMessage _loc this "NO_DATABASE" nil 0; 0 ) else if index == 3 then ( _DLGMessageBox _channel nil titleMessage _loc this "INVALID_USER" nil 0; 0 ) else if index == 1 then ( _ADDlist Iadmin.A_RlistLogin 500 pseudo; 0 ) else if index == 2 then ( _ADDlist Iadmin.A_PlistLogin 500 pseudo; 0 ) else nil; 0 ;; /**************************************************************************** check if the login exist in the database btn -> Button : addlogin button auth -> I : list to add ****************************************************************************/ fun cbAddUser (btn, auth) = let _GETtext Iadmin.A_pseudo -> pseudo in if !strcmpi pseudo "" then nil else let if auth == 1 then Iadmin.A_RlistLogin else Iadmin.A_PlistLogin -> list in ( _SELlist list (-1); _SSELlist list pseudo; let _GETlist list -> [_ test] in if test == nil then _DMSsend this SRequestID [pseudo auth] else (_DLGMessageBox _channel nil (_loc this "ELO_TITLE" nil) (_loc this "ELO_BODY" nil) 0;0) ) ;; /*************************************************************************** remove a login from the post list btn -> Button : remove button param -> parameter : not used ***************************************************************************/ fun cbDeleteToPost (btn, param) = let _GETlist Iadmin.A_PlistLogin -> [_ login] in if login == nil then nil else _SDELlist Iadmin.A_PlistLogin login ;; /**************************************************************************** remove a login from the receive list btn -> Button : remove button param -> paramter : not used *****************************************************************************/ fun cbDeleteToReceive (btn, param) = let _GETlist Iadmin.A_RlistLogin -> [_ login] in if login == nil then nil else _SDELlist Iadmin.A_RlistLogin login ;; /******************************************************************************** Hide the user interface *********************************************************************************/ fun cbHide (from, action, param, others, tag) = _DSwindow Iuser.U_Sinterface; _DSwindow Iuser.U_interface; set Iuser.U_Sinterface = nil; set Iuser.U_interface = nil; _DMSeventTag this "hidden" nil nil nil; 0 ;; /******************************************************************************* fonction recevant les messages du serveur param -> I : numero du message ********************************************************************************/ fun __error (param) = if param == 1 then _DLGMessageBox _channel Iadmin.A_interface (_loc this "ERROR_TITLE" nil) (_loc this "ERROR_DELETE" nil) 0 else if param == 3 then ( _SETtext Iuser.U_sendSujet ""; _SETtext Iuser.U_sendBody ""; _DLGMessageBox _channel Iuser.U_interface (_loc this "OK_SEND_TITLE" nil) (_loc this "OK_SEND_BODY" nil) 0 ) else if param == 4 then _DLGMessageBox _channel Iuser.U_interface (_loc this "AUTH_SEND_TITLE" nil) (_loc this "AUTH_SEND_BODY" nil) 0 else if param == 5 then _DLGMessageBox _channel Iuser.U_interface (_loc this "NOMAIL_TITLE" nil) (_loc this "NOMAIL_BODY" nil) 0 else if param == 6 then ( cbHide nil nil nil nil nil; _DLGMessageBox _channel nil (_loc this "GUEST_TITLE" nil) (_loc this "GUEST_BODY" nil) 0 ) else if param == 10 then _DLGMessageBox _channel Iuser.U_interface (_loc this "EML_TITLE" nil) (_loc this "EML_BODY" nil) 0 else nil ;; /******************************************************************************* fonction transformant le contenue d'un ObjList en list contenue -> ObjList : l'objList a transformer <- [S r1] : le contenue sous forme de list ********************************************************************************/ fun TobjlistTolist (contenue) = if (_GETlistCount contenue) == 0 then nil else ( _SELlist contenue 0; let _GETlist contenue -> [_ login] in ( _DELlist contenue 0; login::TobjlistTolist contenue ) ) ;; /****************************************************************************** add a mailinglist btn -> Button : add mailinglist button param -> parameter : not used *******************************************************************************/ fun cbAddML (btn, param) = let _GETtext Iadmin.A_newML -> name in if !strcmpi name "" then nil else ( if (strlen name) < 2 then ( _DLGMessageBox _channel nil (_loc this "ERROR_TITLE" nil) (_loc this "ERROR_NAME" nil) 0; 0 ) else ( let strbuild ("Name"::name::nil):: ("TypeReceive"::"public"::nil):: ("TypePost"::"public"::nil):: nil -> newML in ( _RSTlist Iadmin.A_listeML; eraseAll; _DMSsend this SAddML [newML 1] ); _SETtext Iadmin.A_newML ""; 0 ) ) ;; /******************************************************************************* Update a mailinglist btn -> Button : update button param -> parameter : notused *******************************************************************************/ fun cbModifyML (btn, param) = _DLGMessageBox _channel nil (_loc this "MODIFY_TITLE" nil) (_loc this "MODIFY_BODY" nil) 0; let _GETlist Iadmin.A_listeML -> [_ name] in let _GETtext Iadmin.A_theme -> theme in let TobjlistTolist Iadmin.A_RlistLogin -> toReceive in let TobjlistTolist Iadmin.A_PlistLogin -> toPost in let strbuild ("Name"::name::nil):: ("Theme"::theme::nil):: ("TypeReceive"::Iadmin.A_TypeReceive::nil):: ("ListUserReceive"::(linebuild toReceive)::nil):: ("TypePost"::Iadmin.A_TypePost::nil):: ("ListUserPost"::(linebuild toPost)::nil):: nil -> newML in ( _RSTlist Iadmin.A_listeML; eraseAll; _DMSsend this SAddML [newML 2] ) ;; /****************************************************************************** sur click du mode private on appel cette fonction checkBtn -> ObjCheck : private check param -> parameter : check state -> I : state of the check *******************************************************************************/ fun cbRightsReceive (checkBtn, param, state) = if (param == 1) then ( set Iadmin.A_TypeReceive = "public"; _SHOWlist Iadmin.A_RlistLogin WINDOW_HIDDEN; _SHOWbutton Iadmin.A_Treceive WINDOW_HIDDEN; _SHOWbutton Iadmin.A_Areceive WINDOW_HIDDEN; if _GETcheck Iadmin.A_CPupost then _ENtext Iadmin.A_pseudo 0 else nil ) else ( set Iadmin.A_TypeReceive = "private"; _SHOWlist Iadmin.A_RlistLogin WINDOW_UNHIDDEN; _SHOWbutton Iadmin.A_Treceive WINDOW_UNHIDDEN; _SHOWbutton Iadmin.A_Areceive WINDOW_UNHIDDEN; _ENtext Iadmin.A_pseudo 1; ); 0 ;; /****************************************************************************** sur click du mode private on appel cette fonction checkBtn -> ObjCheck : private check param -> parameter : check state -> I : state of the check *******************************************************************************/ fun cbRightsPost (checkBtn, param, state) = if (param == 1) then ( set Iadmin.A_TypePost = "public"; _SHOWlist Iadmin.A_PlistLogin WINDOW_HIDDEN; _SHOWbutton Iadmin.A_Tpost WINDOW_HIDDEN; _SHOWbutton Iadmin.A_Apost WINDOW_HIDDEN; if _GETcheck Iadmin.A_CPureceive then _ENtext Iadmin.A_pseudo 0 else nil ) else ( set Iadmin.A_TypePost = "private"; _SHOWlist Iadmin.A_PlistLogin WINDOW_UNHIDDEN; _SHOWbutton Iadmin.A_Tpost WINDOW_UNHIDDEN; _SHOWbutton Iadmin.A_Apost WINDOW_UNHIDDEN; _ENtext Iadmin.A_pseudo 1; ); 0 ;; /********************************************************************************* l'utilisateur a choisi une mailinglist a modifier list -> ObjList : liste de selection param -> parameter : not used pos -> I : position of the item mailinglist -> S : name of the choose mailinglist **********************************************************************************/ fun cbChooseML (list, param, pos, mailinglist) = _DMSsend this SsendML [mailinglist] ;; /******************************************************************************* demande de suppression d'une mailinglist au serveur btn -> Button : bouton valider param -> paramater : not used ********************************************************************************/ fun cbDeleteML (btn, param) = let _GETlist Iadmin.A_listeML -> [pos mailinglist] in if mailinglist == nil then ( _DLGMessageBox _channel nil (_loc this "ERROR_TITLE" nil) (_loc this "ERROR_SELECT" nil) 0; 0 ) else ( _RSTlist Iadmin.A_listeML; _DMSsend this SdeleteML [mailinglist]; eraseAll ); 0 ;; /******************************************************************************** fill the mailinglist list list -> [[S r1] r1] : list for fill the list Mlist -> ObjList : list to fill *********************************************************************************/ fun fillList (list, Mlist) = if list == nil then nil else ( let list -> [name [theme q]] in ( set listML = [(hd name) (hd theme)]::listML; _ADDlist Mlist 0 (hd name) ); fillList (tl tl list) Mlist; 0 ) ;; /****************************************************************************** find a mailing list element -> [S S] : element of the list name -> S : name of the mailinglist to find *******************************************************************************/ fun cbSearchML (element, name) = let element -> [ename _] in !strcmpi ename name ;; /****************************************************************************** callback to show the theme of a choose mailinglist list -> ObjList : list of mailinglist Ttheme -> ObjText : text where to write theme pos -> I : position of the selected item element -> S : element selected *******************************************************************************/ fun cbClickML (list, Ttheme, pos, element) = let search_in_list listML @cbSearchML element ->f in if f == nil then nil else let f -> [_ theme] in _SETtext Ttheme theme; _ENbutton Iuser.U_btnSendMail 1; _ENcheck Iuser.U_normalMail 1; _ENcheck Iuser.U_noMail 1; _DMSsend this Sreception [element 0] ;; /******************************************************************************** reception de la liste des mailinglist param -> S : mailing list (nom et theme) *********************************************************************************/ fun __ListML (param, type, smailinglist) = if type == 1 then ( fillList (strextr param) Iadmin.A_listeML; _SSELlist Iadmin.A_listeML smailinglist; cbChooseML Iadmin.A_listeML nil nil smailinglist; 0 ) else if type == 2 then ( _ENbutton Iuser.U_btnSendMail 0; _ENcheck Iuser.U_normalMail 0; _ENcheck Iuser.U_noMail 0; fillList (strextr param) Iuser.U_listofName; _SSELlist Iuser.U_listofName smailinglist; cbClickML Iuser.U_listofName Iuser.U_themeML nil smailinglist; 0 ) else ( _RSTlist Iuser.U_listofSName; _ENbutton Iuser.U_btnSendMail 0; _ENcheck Iuser.U_normalMail 0; _ENcheck Iuser.U_noMail 0; fillList (strextr param) Iuser.U_listofSName ); 0 ;; /****************************************************************************** user subscribe or unsubscribe to a mailinglist btn -> Button : subscribe button type -> I : subscribe or unsubscribe ******************************************************************************/ fun cbSubscribe (btn, type) = if type == 1 then let _GETlist Iuser.U_listofSName -> [pos name] in if name == nil then nil else ( _DELlist Iuser.U_listofSName pos; _SETtext Iuser.U_themeSML ""; _RSTlist Iuser.U_listofName; _DMSsend this Ssubscribe [name 1] ) else let _GETlist Iuser.U_listofName -> [pos name] in if name == nil then nil else ( _DELlist Iuser.U_listofName pos; _SETtext Iuser.U_themeML ""; _RSTlist Iuser.U_listofSName; _DMSsend this Ssubscribe [name 2] ) ;; /******************************************************************************* change ce reception type of a mailinglist check -> OcjCheck : check box type -> I : type of change value -> I : check or not *******************************************************************************/ fun cbCahngeReception (check, type, value) = let _GETlist Iuser.U_listofName -> [pos name] in _DMSsend this Sreception [name type] ;; /***************************************************************************** the send mail button has been press btn -> Button : send mail button param -> parameter : not used ******************************************************************************/ fun cbSendMail (btn, param) = let _GETlist Iuser.U_listofName -> [pos name] in if name == nil then nil else let _GETtext Iuser.U_sendSujet -> subject in if !strcmpi subject "" then (_DLGMessageBox _channel nil (_loc this "SUBJECT" nil) (_loc this "NO_SUBJECT_BODY" nil) 0;0) else let _GETtext Iuser.U_sendBody -> body in if !strcmpi body "" then (_DLGMessageBox _channel nil (_loc this "NO_BODY_TITLE" nil) (_loc this "NO_BODY_BODY" nil) 0;0) else _DMSsend this SsendMail [name subject body] ;; /****************************************************************************** callback when destroy the user interface win -> ObjWin : user interface param -> parameter : not used *******************************************************************************/ fun cbDestroyIuser (win, param) = _DSwindow Iuser.U_Sinterface; set Iuser.U_Sinterface = nil; set Iuser.U_interface = nil ;; /****************************************************************************** callback when destroy the subscribe interface win -> ObjWin : subscribe interface param -> parameter : not used *******************************************************************************/ fun cbDestroyIsubscribe (win, param) = set Iuser.U_Sinterface = nil ;; /****************************************************************************** call the window to subscribe a amilinglist btn -> ObjButton : subcribe button param -> parameter : not used *******************************************************************************/ fun cbOpenSWindow (btn, param) = if Iuser.U_Sinterface == nil then ( set Iuser.U_Sinterface = _CRwindow _channel Iuser.U_interface 0 0 500 100 WN_DOWN|WN_MENU (_loc this "ISUBSCRIBE" nil); _CRtext _channel Iuser.U_Sinterface 5 5 200 15 0 (_loc this "LIST_ML_A" nil); set Iuser.U_listofSName = _CRlist _channel Iuser.U_Sinterface 5 20 250 75 LB_VSCROLL|LB_BORDER|LB_DOWN; _CRtext _channel Iuser.U_Sinterface 260 5 200 15 0 (_loc this "THEME_ML" nil); set Iuser.U_themeSML = _CRtext _channel Iuser.U_Sinterface 260 20 235 50 ET_AVSCROLL|ET_BORDER|ET_DOWN|ET_VSCROLL " "; set Iuser.U_btnSub = _CRbutton _channel Iuser.U_Sinterface 320 75 100 20 0 (_loc this "ABONNER" nil); _CBbutton Iuser.U_btnSub @cbSubscribe 1; _CBlistClick Iuser.U_listofSName @cbClickML Iuser.U_themeSML; _CBwinDestroy Iuser.U_Sinterface @cbDestroyIsubscribe nil; _DMSsend this SListML [3]; 0 ) else ( _SETfocus Iuser.U_Sinterface; 0 ) ;; /****************************************************************************** callback to count text in the body text -> ObjText : body text param -> parameter : not used ******************************************************************************/ fun cbModifyText (text, param) = let strlen _GETtext text -> size in if size < 10000 then _SETtext Iuser.U_bodySize itoa size else ( _SETtext text substr _GETtext text 0 10000; let strlen _GETtext text -> size in _SETtext Iuser.U_bodySize itoa size ) ;; /****************************************************************************** callback for show the users interface from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : not used others -> [User r1] : not used tag -> Tag : not used <- I : nothing special ********************************************************************************/ fun cbShow (from, action, param, others, tag) = if !strcmpi (substr DMSlogin 0 5) "guest" then ( _DLGMessageBox _channel nil (_loc this "GUEST_TITLE" nil) (_loc this "GUEST_BODY" nil) 0; 0 ) else if Iuser.U_interface == nil then ( set Iuser.U_interface = _CRwindow _channel DMSwin nil nil 500 400 WN_MENU+WN_MINBOX+WN_SIZEBOX (_loc this "MAILINGLIST" nil); /* show mailinglist list and theme */ _CRtext _channel Iuser.U_interface 35 5 200 15 0 (_loc this "LIST_ML_NA" nil); set Iuser.U_listofName = _CRlist _channel Iuser.U_interface 35 20 200 100 LB_VSCROLL|LB_BORDER|LB_DOWN; _CRtext _channel Iuser.U_interface 250 5 200 15 0 (_loc this "THEME_ML" nil); set Iuser.U_themeML = _CRtext _channel Iuser.U_interface 250 20 240 50 ET_AVSCROLL|ET_BORDER|ET_DOWN|ET_VSCROLL " "; set Iuser.U_normalMail = _CRcheck _channel Iuser.U_interface 250 80 230 20 CH_RADIO (_loc this "MAIL_NORMAL" nil); set Iuser.U_noMail = _CRcheck _channel Iuser.U_interface 250 100 230 20 CH_RADIO (_loc this "MAIL_NOMAIL" nil); _CRtext _channel Iuser.U_interface 10 130 60 20 0(_loc this "SUBJECT" nil); set Iuser.U_sendSujet = _CReditText _channel Iuser.U_interface 70 130 420 20 ET_DOWN|ET_BORDER ""; _CRtext _channel Iuser.U_interface 10 155 150 20 0(_loc this "BODY" nil); _CRtext _channel Iuser.U_interface 150 157 290 20 ET_ALIGN_RIGHT (_loc this "BODY_SIZE" nil); set Iuser.U_bodySize = _CRtext _channel Iuser.U_interface 440 155 50 20 ET_DOWN|ET_BORDER "0"; set Iuser.U_sendBody = _CReditText _channel Iuser.U_interface 10 175 480 180 ET_DOWN|ET_BORDER|ET_AVSCROLL|ET_VSCROLL ""; let _LDjpeg _channel _checkpack strcat modulePath "images/corbeille.jpg" -> image in set Iuser.U_Tmailing = _CRbuttonBitmap _channel Iuser.U_interface image 5 35 25 25 0; let _LDbitmap _channel _checkpack strcat modulePath "images/aml.bmp" -> image in set Iuser.U_subscribe = _CRbuttonBitmap _channel Iuser.U_interface image 5 80 25 25 0; set Iuser.U_btnSendMail = _CRbutton _channel Iuser.U_interface 380 365 100 20 0 (_loc this "SEND_BUTTON" nil); /* callback */ _ENbutton Iuser.U_btnSendMail 0; _CBbutton Iuser.U_btnSendMail @cbSendMail nil; _CBbutton Iuser.U_Tmailing @cbSubscribe 2; _CBlistClick Iuser.U_listofName @cbClickML Iuser.U_themeML; _CBwinDestroy Iuser.U_interface @cbDestroyIuser nil; _CBcheck (_ENcheck Iuser.U_normalMail 0) @cbCahngeReception 1; _CBcheck (_ENcheck Iuser.U_noMail 0) @cbCahngeReception 2; _CBbutton Iuser.U_subscribe @cbOpenSWindow nil; _CBtext Iuser.U_sendBody @cbModifyText nil; _DMSsend this SListML [2]; _DMSsend this ScheckMail []; _DMSeventTag this "shown" nil nil nil; 0 ) else ( _SETfocus Iuser.U_interface; 0 ) ;; fun cbBeforeClose () = _DSwindow Iadmin.A_interface ;; /******************************************************************************* receive the ask mailinglist name -> S : name of the mailinglist theme -> S : theme of the mailinglist typereceive -> S typepost -> S Rlist -> S : receive list of login Plist -> S : post list of login *******************************************************************************/ fun __sendML (name, theme, typereceive, typepost, Rlist, Plist) = eraseAll; _SETtext Iadmin.A_theme theme; _ENtext Iadmin.A_theme 1; _ENcheck Iadmin.A_CPureceive 1; _ENcheck Iadmin.A_CPrreceive 1; _ENcheck Iadmin.A_CPupost 1; _ENcheck Iadmin.A_CPrpost 1; _ENbutton Iadmin.A_valider 1; _RSTlist Iadmin.A_RlistLogin; if !strcmpi typereceive "private" then ( _SETcheck Iadmin.A_CPrreceive 1; _SETcheck Iadmin.A_CPureceive 0; cbRightsReceive nil nil 1; apply_on_list (lineextr Rlist) @cbFillList Iadmin.A_RlistLogin ) else ( _SETcheck Iadmin.A_CPureceive 1; _SETcheck Iadmin.A_CPrreceive 0; 0 ); _RSTlist Iadmin.A_PlistLogin; if !strcmpi typepost "private" then ( _SETcheck Iadmin.A_CPrpost 1; _SETcheck Iadmin.A_CPupost 0; cbRightsPost nil nil 1; apply_on_list (lineextr Plist) @cbFillList Iadmin.A_PlistLogin ) else ( _SETcheck Iadmin.A_CPupost 1; _SETcheck Iadmin.A_CPrpost 0; 0 ) ;; /******************************************************************************* change reception chack type -> I : type of reception ********************************************************************************/ fun __reception (type) = if type == 1 then ( _SETcheck Iuser.U_normalMail 1; _SETcheck Iuser.U_noMail 0 ) else ( _SETcheck Iuser.U_noMail 1; _SETcheck Iuser.U_normalMail 0 ); if type == 3 then ( _ENcheck Iuser.U_noMail 0; _ENcheck Iuser.U_normalMail 0 ) else nil ;; /******************************************************************************* callback when destroying the admin interface win -> ObjWin : amin interface param -> parameter : not used *********************************************************************************/ fun cbDestroyIadmin (win, param) = set Iadmin.A_interface = nil; _DMSsend this ScloseAdmin [] ;; /******************************************************************************* open admin interface error -> I : 1 open interface, 2 show error box *********************************************************************************/ fun __admin (error) = if error == 1 then if Iadmin.A_interface == nil then ( set Iadmin.A_interface = _CRwindow _channel DMSwin nil nil width height WN_MENU+WN_MINBOX+WN_SIZEBOX "Mailing List"; _CRtext _channel Iadmin.A_interface 10 5 200 15 0 (_loc this "LIST_ML" nil); set Iadmin.A_listeML = _CRlist _channel Iadmin.A_interface 5 20 240 350 LB_VSCROLL|LB_BORDER|LB_DOWN; _CRtext _channel Iadmin.A_interface 265 20 200 15 0 (_loc this "THEME_ML" nil); set Iadmin.A_theme = _CReditText _channel Iadmin.A_interface 260 35 235 55 ET_AVSCROLL|ET_BORDER|ET_VSCROLL|ET_DOWN ""; _CRtext _channel Iadmin.A_interface 265 102 80 15 0 (_loc this "PSEUDO" nil); set Iadmin.A_pseudo = _CReditText _channel Iadmin.A_interface 345 100 145 20 ET_BORDER|ET_DOWN ""; _CRtext _channel Iadmin.A_interface 265 130 100 30 ET_ALIGN_CENTER (_loc this "A_RECEIVE" nil); _CRtext _channel Iadmin.A_interface 385 130 100 30 ET_ALIGN_CENTER (_loc this "A_POST" nil); set Iadmin.A_newML = _CReditText _channel Iadmin.A_interface 65 377 180 20 ET_BORDER|ET_DOWN ""; set Iadmin.A_BMPcorbeille = _LDjpeg _channel _checkpack strcat modulePath "images/corbeille.jpg"; set Iadmin.A_Tmailing = _CRbuttonBitmap _channel Iadmin.A_interface Iadmin.A_BMPcorbeille 5 375 25 25 0; let _LDbitmap _channel _checkpack strcat modulePath "images/aml.bmp" -> image in set Iadmin.A_Amailing = _CRbuttonBitmap _channel Iadmin.A_interface image 35 375 25 25 0; set Iadmin.A_Wreceive = _CRwindow _channel Iadmin.A_interface 260 165 115 180 WN_CHILDINSIDE "receive"; set Iadmin.A_Wpost = _CRwindow _channel Iadmin.A_interface 380 165 115 180 WN_CHILDINSIDE "post"; let _LDjpeg _channel _checkpack strcat modulePath "images/fleche.jpg" -> image in ( set Iadmin.A_Areceive = _CRbuttonBitmap _channel Iadmin.A_Wreceive image 85 5 25 25 0; set Iadmin.A_Apost = _CRbuttonBitmap _channel Iadmin.A_Wpost image 5 5 25 25 0 ); set Iadmin.A_RlistLogin = _CRlist _channel Iadmin.A_Wreceive 5 30 105 100 LB_VSCROLL|LB_BORDER|LB_DOWN; set Iadmin.A_PlistLogin = _CRlist _channel Iadmin.A_Wpost 5 30 105 100 LB_VSCROLL|LB_BORDER|LB_DOWN; set Iadmin.A_Treceive = _CRbuttonBitmap _channel Iadmin.A_Wreceive Iadmin.A_BMPcorbeille 5 5 25 25 0; set Iadmin.A_Tpost = _CRbuttonBitmap _channel Iadmin.A_Wpost Iadmin.A_BMPcorbeille 85 5 25 25 0; set Iadmin.A_CPureceive = _CRcheck _channel Iadmin.A_Wreceive 5 140 80 20 CH_RADIO _loc this "PUBLIC" nil; set Iadmin.A_CPrreceive = _CRcheck _channel Iadmin.A_Wreceive 5 160 80 20 CH_RADIO _loc this"PRIVATE" nil; set Iadmin.A_CPupost = _CRcheck _channel Iadmin.A_Wpost 5 140 80 20 CH_RADIO _loc this "PUBLIC" nil; set Iadmin.A_CPrpost = _CRcheck _channel Iadmin.A_Wpost 5 160 80 20 CH_RADIO _loc this"PRIVATE" nil; set Iadmin.A_valider = _CRbutton _channel Iadmin.A_interface 335 370 90 20 0 (_loc this "VALIDER" nil); /*callbasck*/ _CBlistClick Iadmin.A_listeML @cbChooseML nil; _CBbutton Iadmin.A_Treceive @cbDeleteToReceive nil; _CBbutton Iadmin.A_Tpost @cbDeleteToPost nil; _CBwinDestroy Iadmin.A_interface @cbDestroyIadmin nil; _CBbutton Iadmin.A_Amailing @cbAddML nil; _CBbutton Iadmin.A_Tmailing @cbDeleteML nil; _CBcheck Iadmin.A_CPureceive @cbRightsReceive 1; _CBcheck Iadmin.A_CPrreceive @cbRightsReceive 2; _CBcheck Iadmin.A_CPupost @cbRightsPost 1; _CBcheck Iadmin.A_CPrpost @cbRightsPost 2; _CBbutton Iadmin.A_valider @cbModifyML nil; _CBbutton Iadmin.A_Areceive @cbAddUser 1; _CBbutton Iadmin.A_Apost @cbAddUser 2; eraseAll; _DMSsend this SListML [1]; 0 ) else ( _SETfocus Iadmin.A_interface; 0 ) else ( _DLGMessageBox _channel nil (_loc this "ADMIN_TITLE" nil) (_loc this "ADMIN_BODY" nil) 0; 0 ) ;; /******************************************************************************* Global comments about the SCOL file structure parameter -> S : String sent by the server by calling _DMScreateClientDMI <- I : nothing special *******************************************************************************/ fun IniDMI (parameter) = _DMSdefineActions this (["show" @cbShow]):: (["hide" @cbHide])::nil; set width = 500; set height = 400; set modulePath = _DMSgetpath _DMSgetClass this; set Iuser = mkIuser [nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil]; set Iadmin = mkIadmin [nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil]; _DMSregister this @cbBeforeClose; 0 ;;