Commit e51c5451 authored by Peter Achten's avatar Peter Achten
Browse files

refactoring modules internally

parent ae109810
definition module loginAdmin
import StdEnv, StdMaybe, htmlRefFormlib
import StdMaybe, htmlRefFormlib, htmlButtons
:: Account s = { login :: Login // login info
, state :: s // state
......
implementation module loginAdmin
import StdEnv, StdHtml, StdMaybe
import StdHtml, StdMaybe
instance == (Account s)
where
......
......@@ -188,7 +188,7 @@ discussPapersPage account accounts hst
# mbpaperrefinfo = getPaperInfo selectedpaper accounts
# (RefDiscussion (Ref2 name)) = (fromJust mbpaperrefinfo).discussion
# (disclist,hst) = universalDB (Init,storageOption,Discussion [],name) (\_ _ -> Ok) hst
# (time,date,hst) = getTimeAndDate hst
# ((time,date),hst) = getTimeAndDate hst
# (newsubmit,newdiscf,hst)
= mkSubStateForm (if pdfun.changed Set Init, nFormId "sh_dpp_adddisc" (TS 80 "")) disclist
(\s -> addItemTextInput (account.login.loginName) time date (toS s)) hst
......@@ -226,22 +226,21 @@ where
showPapersStatusPage :: !ConfAccount !ConfAccounts !*HSt -> ([BodyTag],!*HSt)
showPapersStatusPage account accounts hst
# (pdmenu,hst) = mkEditForm (Init,sFormId "sh_sPSP_pdm" Submitted) hst // to select status of papers you want to see
# (allireports,hst) = getAllMyReports account accounts hst //[(Int,[(Person, Maybe Report)])]
# allpapernrs = map fst allireports
# selpaperinfo = [(nr,paperinfo.status) \\ nr <- allpapernrs
# (pdmenu,hst) = mkEditForm (Init,sFormId "sh_sPSP_pdm" Submitted) hst // to select status of papers you want to see
# (allireports,hst) = getAllMyReports account accounts hst //[(Int,[(Person, Maybe Report)])]
# allpapernrs = map fst allireports
# selpaperinfo = [(nr,paperinfo.status) \\ nr <- allpapernrs
, (Just paperinfo) <- [getPaperInfo nr accounts]
| paperinfo.status == pdmenu.value]
# selpapernrs = map fst selpaperinfo // the number of the papers that have the selected status
| isNil selpapernrs = ([Txt "Show status of all papers which are:",Br,Br] ++ pdmenu.form ++ [Br, Txt "There are no papers that obey these criteria.",Br],hst)
# selreports = [(nr,map snd persreport) \\ (nr,persreport) <- allireports | isMember nr selpapernrs]
# selsummary = [("Paper nr: " <+++ nr, [ (report.recommendation,report.familiarity)
\\ (Just report) <- reports
]
)
\\ (nr,reports) <- selreports]
# (sumlist,hst) = vertlistForm (Set,tdFormId "sh_sPSP_summ" selsummary) hst
# selpapernrs = map fst selpaperinfo // the number of the papers that have the selected status
| isEmpty selpapernrs = ([Txt "Show status of all papers which are:",Br,Br] ++ pdmenu.form ++ [Br, Txt "There are no papers that obey these criteria.",Br],hst)
# selreports = [(nr,map snd persreport) \\ (nr,persreport) <- allireports | isMember nr selpapernrs]
# selsummary = [("Paper nr: " <+++ nr, [ (report.recommendation,report.familiarity)
\\ (Just report) <- reports
])
\\ (nr,reports) <- selreports]
# (sumlist,hst) = vertlistForm (Set,tdFormId "sh_sPSP_summ" selsummary) hst
= ([Txt "List all papers which are:",Br,Br] ++ pdmenu.form ++ [Br] ++ sumlist.form,hst)
// utility
......
......@@ -24,7 +24,7 @@ derive bimap Form, FormId
// doHtml main wrapper for generating & handling of a Html form
doHtml :: !.(*HSt -> (Html,!*HSt)) !*World -> *World // use this application with some external server and php
doHtmlServer :: ! (*HSt -> (Html,!*HSt)) !*World -> *World // use this application with the build-in Clean server: http://localhost/clean
doHtmlServer :: ! (*HSt -> (Html,!*HSt)) !*World -> *World // use this application with the built-in Clean server: http://localhost/clean
// mkViewForm is the *swiss army knife* function creating stateful interactive forms with a view v of data d.
// Make sure that all editors have a unique identifier!
......
......@@ -476,52 +476,52 @@ mkInput size (init,_) val _ hst=:{cntr}
toHtml :: a -> BodyTag | gForm {|*|} a
toHtml a
# (na,_) = gForm{|*|} (Set,mkFormId "__toHtml" a <@ Display) (mkHSt emptyFormStates undef)
# (na,_) = gForm{|*|} (Set,mkFormId "__toHtml" a <@ Display) (mkHSt emptyFormStates undef)
= BodyTag na.form
toHtmlForm :: !(*HSt -> *(Form a,*HSt)) -> [BodyTag] | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
toHtmlForm anyform
# (na,hst) = anyform (mkHSt emptyFormStates undef)
# (na,hst) = anyform (mkHSt emptyFormStates undef)
= na.form
toBody :: (Form a) -> BodyTag
toBody form = BodyTag form.form
toBody form = BodyTag form.form
createDefault :: a | gUpd{|*|} a
createDefault = fromJust (snd (gUpd {|*|} (UpdSearch (UpdC "Just") 0) Nothing))
createDefault = fromJust (snd (gUpd {|*|} (UpdSearch (UpdC "Just") 0) Nothing))
derive gUpd Maybe
setCntr :: InputId *HSt -> *HSt
setCntr i hst = {hst & cntr = i}
setCntr i hst = {hst & cntr = i}
incrHSt :: Int !*HSt -> *HSt
incrHSt i hst = {hst & cntr = hst.cntr + i} // BUG ??????
incrHSt i hst = {hst & cntr = hst.cntr + i} // BUG ??????
CntrHSt :: !*HSt -> (Int,*HSt)
CntrHSt hst=:{cntr} = (cntr,hst)
CntrHSt hst=:{cntr} = (cntr,hst)
getChangedId :: !*HSt -> (String,!*HSt) // id of form that has been changed by user
getChangedId hst=:{states}
# (id,states) = getUpdateId states
# (id,states) = getUpdateId states
= (id,{hst & states = states })
// Enabling file IO on HSt
instance FileSystem HSt where
fopen string int hst=:{world}
# (bool,file,world) = fopen string int world
# (bool,file,world) = fopen string int world
= (bool,file,{hst & world = world})
fclose file hst=:{world}
# (bool,world) = fclose file world
# (bool,world) = fclose file world
= (bool,{hst & world = world})
stdio hst=:{world}
# (file,world) = stdio world
# (file,world) = stdio world
= (file,{hst & world = world})
sfopen string int hst=:{world}
# (bool,file,world) = sfopen string int world
# (bool,file,world) = sfopen string int world
= (bool,file,{hst & world = world})
// General access to the World environment on HSt:
......@@ -539,5 +539,5 @@ accWorldHSt f hst=:{world}
runUserApplication :: .(*HSt -> *(.a,*HSt)) *FormStates *NWorld -> *(.a,*FormStates,*NWorld)
runUserApplication userpage states nworld
# (html,{states,world}) = userpage (mkHSt states nworld)
# (html,{states,world}) = userpage (mkHSt states nworld)
= (html,states,world)
definition module htmlRefFormlib
import StdEnv, htmlHandler, htmlButtons
import htmlHandler
// The Refto structure is used to refer to a file with indicated name containing a value of indicated type
// This can be used to share information, the file name is used as key
// The file is openend read-only (Mode = Display) or it can be edited and the new value will be written to file
// The Refto structure is used to refer to a file with indicated name containing a value of indicated type.
// This can be used to share information, the file name is used as key.
// The file is openend read-only (Mode = Display) or it can be edited and the new value is written to file.
:: Ref2 a = Ref2 String
instance == (Ref2 a)
ref2EditForm :: !(InIDataId a) !(InIDataId (Ref2 a)) !*HSt -> (Form a,!*HSt) | iData a
invokeRefEditor :: !((InIDataId b) *HSt -> (Form d,*HSt)) (InIDataId b) !*HSt -> (Form b,!*HSt)
universalRefEditor :: !Lifespan !(InIDataId (Ref2 a)) !(a -> Judgement) !*HSt -> (Form a,!*HSt) | iData a
universalDB :: !(!Init,!Lifespan,!a,!String) !(String a -> Judgement) !*HSt -> (a,!*HSt) | iData a
// Usefull for exception handling
// Useful for exception handling
:: Judgement :== Maybe (String,String) // id + message
Ok :: Judgement
noException :: Judgement -> Bool
yesException :: Judgement -> Bool
instance + Judgement
instance + Judgement
ExceptionStore :: (Judgement -> Judgement) !*HSt -> (Judgement,!*HSt)
ExceptionStore :: (Judgement -> Judgement) !*HSt -> (Judgement,!*HSt)
implementation module htmlRefFormlib
// Handy collection of Form's
// (c) MJP 2005
// Database storages and reference types that allow destructive sharing of model data types.
// Both can be guarded by consistency checking functions.
// Both handle version management of the stored and shared data respectively.
// (c) MJP 2006
import StdEnv, StdHtml, StdLib
import GenEq
import StdHtml
derive gForm []; derive gUpd []
derive gForm Maybe
......@@ -12,258 +13,95 @@ derive gUpd Maybe
derive gPrint Maybe
derive gParse Maybe
:: Ref2 a = Ref2 String
:: Ref2 a = Ref2 String
instance == (Ref2 a)
where
(==)(Ref2 file1) (Ref2 file2) = file1 == file2
instance == (Ref2 a) where (==) (Ref2 file1) (Ref2 file2) = file1 == file2
ref2EditForm :: !(InIDataId a) !(InIDataId (Ref2 a)) !*HSt -> (Form a,!*HSt) | iData a
ref2EditForm (inita,formida) (_,{ival=Ref2 refname}) hst
| refname == "" = mkEditForm (Init,reuseFormId formida createDefault) hst
| otherwise = mkEditForm (inita,{formida & id = refname}) hst
invokeRefEditor :: !((InIDataId b) *HSt -> (Form d,*HSt)) (InIDataId b) !*HSt -> (Form b,!*HSt)
invokeRefEditor editor (init,formid) hst
# (idata,hst) = editor (init,formid) hst
# (idata,hst) = editor (init,formid) hst
= ({idata & value = formid.ival},hst)
universalRefEditor :: !Lifespan !(InIDataId (Ref2 a)) !(a -> Judgement) !*HSt -> (Form a,!*HSt) | iData a
universalRefEditor lifespan (init,formid) invariant hst
# (Ref2 filename) = formid.ival
| filename == "" = mkEditForm (Init,xtFormId "ure_TEMP" createDefault) hst
# (dbf,hst) = myDatabase Init filename (0,createDefault) hst
// create / read out current value in file file
# dbvalue = dbf.value
# dbversion = fst dbvalue // version number stored in database
# dbvalue = snd dbvalue // value stored in database
# (versionf,hst) = myVersion Init filename dbversion hst // create / read out version number expected by this application
# version = versionf.value // current version number assumed in this application
| init == Init &&
(formid.mode == Display || formid.mode == NoForm || filename == "") // we only want to read, no version conflict
= myEditor Init filename dbvalue hst // synchronize with latest value
| dbversion > version // we have a version conflict and want to write
# (_,hst) = ExceptionStore ((+) (Just (filename, "Ref Your screen data is out of date; I have retrieved the latest data."))) hst // Raise exception
# (_,hst) = myVersion Set filename dbversion hst // synchronize with new version
= myEditor Set filename dbvalue hst // return current version stored in database
# (valuef,hst) = myEditor Init filename dbvalue hst // editor is in sync; create / read out current value
# exception = invariant valuef.value // check invariants // check invariants
| isJust exception // we want to write, but invariants don't hold
# (_,hst) = ExceptionStore ((+) exception) hst // report them
= (valuef,hst) // return wrong value such that it can be improved
# (versionf,hst) = myVersion Set filename (dbversion + 1) hst// increment version number
# (_,hst) = myDatabase Set filename (dbversion + 1,valuef.value) hst // update database file
// iData for destructively shared model data:
universalRefEditor :: !Lifespan !(InIDataId (Ref2 a)) !(a -> Judgement) !*HSt -> (Form a,!*HSt) | iData a
universalRefEditor lifespan (init,formid=:{ival=Ref2 filename}) invariant hst
| filename == "" = mkEditForm (Init,xtFormId "ure_TEMP" createDefault) hst
# (dbf,hst) = myDatabase Init filename (0,createDefault) hst // create / read out current value in file file
# (dbversion,dbvalue) = dbf.value // version number and value stored in database
# (versionf,hst) = myVersion Init filename dbversion hst // create / read out version number expected by this application
# version = versionf.value // current version number assumed in this application
| init == Init && isMember formid.mode [Display,NoForm] // we only want to read, no version conflict
= myEditor Init filename dbvalue hst // synchronize with latest value
| dbversion > version // we have a version conflict and want to write
# (_,hst) = ExceptionStore ((+) (Just (filename, "Ref Your screen data is out of date; I have retrieved the latest data."))) hst
// Raise exception
# (_,hst) = myVersion Set filename dbversion hst // synchronize with new version
= myEditor Set filename dbvalue hst // return current version stored in database
# (valuef,hst) = myEditor Init filename dbvalue hst // editor is in sync; create / read out current value
# exception = invariant valuef.value // check invariants // check invariants
| isJust exception // we want to write, but invariants don't hold
# (_,hst) = ExceptionStore ((+) exception) hst // report them
= (valuef,hst) // return wrong value such that it can be improved
# (versionf,hst) = myVersion Set filename (dbversion + 1) hst // increment version number
# (_,hst) = myDatabase Set filename (dbversion + 1,valuef.value) hst // update database file
= ({valuef & changed = True},hst)
where
myDatabase dbinit filename cntvalue hst
# databaseId = {reuseFormId formid (Ref2 filename) & id = formid.id +++ "refto" /*+++ filename*/}
= ref2EditForm (dbinit, storeFormId "" cntvalue) (init,databaseId) hst // write the database
storeFormId => if (lifespan == Persistent) xpFormId xdbFormId
/*
= case dbinit of
// Init = ref2EditForm (Init,xrFormId "" cntvalue) (init,databaseId) hst // read the database
Init = ref2EditForm (Init,storeFormId "" cntvalue) (init,databaseId) hst // read the database
Set = ref2EditForm (Set, storeFormId "" cntvalue) (init,databaseId) hst // write the database
*/
myVersion init filename cnt hst = mkEditForm (init,{reuseFormId formid cnt & id = ("vrs_r_" +++ filename)
, mode = NoForm}) hst // to remember version number
myEditor :: !Init !String !a *HSt -> (Form a,!*HSt) | iData a
myEditor init filename value hst
# formId = {reuseFormId formid value & id = "copy_r_" +++ filename}
= mkShowHideForm (init,formId) hst // copy of database information
myDatabase init filename cntvalue hst // write the database
= mkEditForm (init, if (lifespan == Persistent) xpFormId xdbFormId "" cntvalue <@ filename) hst
myVersion init filename cnt hst // track version number
= mkEditForm (init,reuseFormId formid cnt <@ ("vrs_r_" +++ filename) <@ NoForm) hst
myEditor init filename value hst // copy of database information
= mkShowHideForm (init,reuseFormId formid value <@ "copy_r_" +++ filename) hst
// editor for persistent information
// editor for persistent information:
universalDB :: !(!Init,!Lifespan,!a,!String) !(String a -> Judgement) !*HSt -> (a,!*HSt) | iData a
universalDB :: !(!Init,!Lifespan,!a,!String) !(String a -> Judgement) !*HSt -> (a,!*HSt) | iData a
universalDB (init,lifespan,value,filename) invariant hst
# (dbf,hst) = myDatabase Init 0 value hst // create / read out database file
# dbversion = fst dbf.value // version number stored in database
# dbvalue = snd dbf.value // value stored in database
# (versionf,hst) = myVersion Init dbversion hst // create / read out version number expected by this application
# version = versionf.value // current version number assumed in this application
| init == Init // we only want to read, no version conflict
# (_,hst) = myVersion Set dbversion hst // synchronize version number and
= (dbvalue,hst) // return current value stored in database
| dbversion <> version // we want to write and have a version conflict
# (_,hst) = myVersion Set dbversion hst // synchronize with new version
# (_,hst) = ExceptionStore ((+) (Just (filename,"Your screen data is out of date; I have retrieved the latest data."))) hst // Raise exception
= (dbvalue,hst) // return current version stored in database
# exception = invariant filename value // no version conflict, check invariants // check invariants
| isJust exception // we want to write, but invariants don't hold
# (_,hst) = ExceptionStore ((+) exception) hst // report them
= (value,hst) // return disapproved value such that it can be improved
# (versionf,hst) = myVersion Set (dbversion + 1) hst // increment version number
# (_,hst) = myDatabase Set versionf.value value hst // update database file
# (dbf,hst) = myDatabase Init (0,value) hst // create / read out database file
# (dbversion,dbvalue) = dbf.value // version number and value stored in database
# (versionf,hst) = myVersion Init dbversion hst // create / read out version number expected by this application
# version = versionf.value // current version number assumed in this application
| init == Init // we only want to read, no version conflict
# (_,hst) = myVersion Set dbversion hst // synchronize version number and
= (dbvalue,hst) // return current value stored in database
| dbversion <> version // we want to write and have a version conflict
# (_,hst) = myVersion Set dbversion hst // synchronize with new version
# (_,hst) = ExceptionStore ((+) (Just (filename,"Your screen data is out of date; I have retrieved the latest data."))) hst
// Raise exception
= (dbvalue,hst) // return current version stored in database
# exception = invariant filename value // no version conflict, check invariants // check invariants
| isJust exception // we want to write, but invariants don't hold
# (_,hst) = ExceptionStore ((+) exception) hst // report them
= (value,hst) // return disapproved value such that it can be improved
# (versionf,hst) = myVersion Set (dbversion + 1) hst // increment version number
# (_,hst) = myDatabase Set (versionf.value,value) hst // update database file
= (value,hst)
where
myDatabase init cnt value hst = mkEditForm (init,{storeFormId filename (cnt,value) & mode = NoForm}) hst // read the database
where
storeFormId = if (lifespan == Persistent) pFormId dbFormId
myVersion init cnt hst = mkEditForm (init,xtFormId ("vrs_db_" +++ filename) cnt) hst // to remember version number
myDatabase init cntvalue hst // read the database
= mkEditForm (init,if (lifespan == Persistent) pFormId dbFormId filename cntvalue <@ NoForm) hst
myVersion init cnt hst = mkEditForm (init,xtFormId ("vrs_db_" +++ filename) cnt) hst // to remember version number
// Exception handling
Ok :: Judgement
Ok = Nothing
Ok = Nothing
noException :: Judgement -> Bool
noException judgement = isNothing judgement
noException judgement = isNothing judgement
yesException :: Judgement -> Bool
yesException judgement = not (noException judgement)
yesException judgement = not (noException judgement)
instance + Judgement
where
(+) j1 j2 = addJudgement j1 j2
where
// addJudgement (Just (r1,j1)) (Just (r2,j2)) = (Just ((r1 +++ " " +++ r2),(j1 +++ " " +++ j2))) //for debugging
addJudgement (Just j1) _ = Just j1
addJudgement _ (Just j2) = Just j2
addJudgement _ _ = Nothing
instance + Judgement where
// (+) (Just (r1,j1)) (Just (r2,j2)) = (Just ((r1 +++ " " +++ r2),(j1 +++ " " +++ j2))) //for debugging
(+) (Just j1) _ = Just j1
(+) _ (Just j2) = Just j2
(+) _ _ = Nothing
ExceptionStore :: (Judgement -> Judgement) !*HSt -> (Judgement,!*HSt)
ExceptionStore judge hst
# (judgef,hst) = mkStoreForm (Init,{nFormId "handle_exception" Ok & mode = NoForm, lifespan = Temp}) judge hst
# (judgef,hst) = mkStoreForm (Init,nFormId "handle_exception" Ok <@ NoForm <@ Temp) judge hst
= (judgef.value,hst)
/*
:: Refto a = Refto String
reftoEditForm :: !(!Init,!Mode!,!Lifespan) !(InIDataId (Refto a,a)) !*HSt -> (Form (Refto a),Form a,!*HSt) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
reftoEditForm (initv,modev,lifespan) (init,formid) hst
# (ref,hst) = mkEditForm (init, reuseFormId formid (Refto filename)) hst
# (Refto nname) = ref.value
# (file,hst) = mkEditForm (initv,{ formid & id = nname
, ival = a
, lifespan = lifespan
, mode = modev
}) hst
= ( {ref & form = [[toHtml ("File Name: " )] <=> ref.form]}
, {file & form = [[toHtml (nname +++ ": ")] <=> file.form]}
, hst
)
where
(Refto filename,a) = formid.ival
// special editors on top of this ...
reftoVertListForm :: !(!Init,!Mode!,!Lifespan) !(InIDataId [(Refto a,a)]) !*HSt -> (Form [Refto a],Form [a],!*HSt) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
reftoVertListForm options (init,formid) hst
# storeid = reuseFormId formid [Refto name\\ (Refto name,_) <- formid.ival]
# (store,hst) = mkStoreForm (init,storeid) id hst // store for refto list
# (twof,hst) = maplSt (reftoEditForm` options) [(init,subnFormId formid (name <+++ i) (Refto name,a))
\\ (Refto name) <- store.value
& (_,a) <- formid.ival ++ repeat (Refto "",createDefault)
& i <- [1..] ] hst
# (fref,ffile) = unzip twof
# frefvalue = [elem.value \\ elem <- fref]
# (store,hst) = mkStoreForm (init,storeid) (\list -> frefvalue) hst
= ( { changed = or [elem.changed \\ elem <- fref]
, value = [elem.value \\ elem <- fref]
, form = [BodyTag elem.form \\ elem <- fref]
}
, { changed = or [elem.changed \\ elem <- ffile]
, value = [elem.value \\ elem <- ffile]
, form = [BodyTag elem.form \\ elem <- ffile]
},hst)
where
reftoEditForm` options all hst
# (fref,ffile,hst) = reftoEditForm options all hst
= ((fref,ffile),hst)
reftoListFormButs :: !Int !(!Init,!Mode!,!Lifespan) !(InIDataId [(Refto a,a)]) !*HSt -> (Form [Refto a],Form [a],!*HSt) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
reftoListFormButs nbuts (initv,mode,lifespan) (init,formid) hst
# indexId = {subsFormId formid "idx" 0 & mode = Edit}
# (index,hst) = mkEditForm (init,indexId) hst
# (rlist,vlist,hst)= reftoVertListForm (initv,mode,lifespan) (init,formid) hst
# lengthlist = length rlist.value
# pdmenu = PullDown (1,defpixel) (0, [toString lengthlist +++ " More... " :["Show " +++ toString i \\ i <- [1 .. max 1 lengthlist]]])
# pdmenuId = {subsFormId formid "pdm" pdmenu & mode = Edit}
# (pdbuts,hst) = mkEditForm (Init, pdmenuId) hst
# (PullDown _ (step,_)) = pdbuts.value
| step == 0 = (rlist,{form=pdbuts.form,value=vlist.value,changed=rlist.changed || vlist.changed || pdbuts.changed},hst)
# bbutsId = {subsFormId formid "bb" index.value & mode = Edit}
# (obbuts, hst) = browseButtons (Init, bbutsId) step lengthlist nbuts hst
# addId = subnFormId formid "add" addbutton
# (add ,hst) = ListFuncBut (Init, addId) hst
# dellId = subnFormId formid "dell" (delbutton obbuts.value step)
# (del ,hst) = ListFuncBut (Init, dellId) hst
# insrtId = subnFormId formid "ins" (insertbutton createDefault obbuts.value step)
# (ins ,hst) = ListFuncBut (Init, insrtId) hst
# appId = subnFormId formid "app" (appendbutton createDefault obbuts.value step)
# (app ,hst) = ListFuncBut (Init, appId) hst
# elemId = subsFormId formid "copyelem" createDefault
# copyId = subnFormId formid "copy" (copybutton obbuts.value step)
# (copy ,hst) = ListFuncBut (Init, copyId) hst
# (elemstore,hst)= mkStoreForm (Init,elemId) (if copy.changed (\_ -> vlist.value!!copy.value 0) id) hst
# pasteId = subnFormId formid "paste" (pastebutton obbuts.value step)
# (paste,hst) = ListFuncBut (Init, pasteId) hst
# newlist = rlist.value
# newlist = ins.value newlist
# newlist = add.value newlist
# newlist = app.value newlist
# newlist = del.value newlist
# (_,_,hst) = if paste.changed (reftoEditForm (Set,mode,Persistent)
(Init,nFormId "ttt" (rlist.value!!(paste.value 0),elemstore.value )) hst)
(undef,undef,hst)
# (rlist,vlist,hst)= reftoVertListForm (initv,mode,lifespan) (setID formid [(reftoa,createDefault) \\ reftoa <- newlist]) hst
# lengthlist = length rlist.value
# (index,hst) = mkEditForm (setID indexId obbuts.value) hst
# (bbuts, hst) = browseButtons (Init, bbutsId) step lengthlist nbuts hst
# betweenindex = (bbuts.value,bbuts.value + step - 1)
# pdmenu = PullDown (1,defpixel) (step, [toString lengthlist +++ " More... ":["Show " +++ toString i \\ i <- [1 .. max 1 lengthlist]]])
# (pdbuts,hst) = mkEditForm (setID pdmenuId pdmenu) hst
= ( rlist
, { form = pdbuts.form ++ bbuts.form ++
[[(toHtml ("nr " <+++ (i+1) <+++ " / " <+++ length rlist.value) <.||.>
(onMode formid.mode (del <.=.> ins <.=.> app <.=.> copy <.=.> paste) EmptyBody EmptyBody))
\\ del <- del.form & ins <- ins.form & app <- app.form & copy <- copy.form & paste <- paste.form
& i <- [bbuts.value..]]
<=|> [re <.=.> ve \\ re <- rlist.form%betweenindex & ve <- vlist.form%betweenindex]] ++
(if (lengthlist <= 0) add.form [])
, value = vlist.value
, changed = rlist.changed || vlist.changed || obbuts.changed || del.changed || pdbuts.changed ||ins.changed ||
add.changed || copy.changed || paste.changed
}
, hst )
where
addbutton =
[ (but 1 "Append", \_ -> [createDefault])]
but i s = LButton (defpixel/i) s
delbutton index step =
[ (but 5 "D", \list -> removeAt i list) \\ i <- [index .. index + step]]
insertbutton e index step =
[ (but 5 "I", \list -> insertAt i e list) \\ i <- [index .. index + step]]
appendbutton e index step =
[ (but 5 "A", \list -> insertAt (i+1) e list) \\ i <- [index .. index + step]]
copybutton index step =
[ (but 5 "C", \_ -> i) \\ i <- [index .. index + step]]
pastebutton index step =
[ (but 5 "P", \_ -> i) \\ i <- [index .. index + step]]
*/
\ No newline at end of file
......@@ -4,30 +4,28 @@ import htmlHandler
// Global settings of iData applications
class iData a // The collection of generic functions needed to make iData:
| gForm {|*|} // Creates an Html Form
, gUpd {|*|} // Makes it possible to edit the form and updates the corresponding value
class iData a // The collection of generic functions needed to make iData:
| gForm {|*|} // Creates an Html Form
, gUpd {|*|} // Makes it possible to edit the form and updates the corresponding value
, iDataSerAndDeSerialize a
class iDataSerialize a
| gPrint{|*|} // To serialize a value to a String
// , gerda {|*|} // OPTION: To store and retrieve a value in a database
, TC a // To be able to store values in a dynamic
// TC is a special class cannot be included here
| gPrint{|*|} // To serialize a value to a String
// , gerda {|*|} // OPTION: To store and retrieve a value in a database
, TC a // To be able to store values in a dynamic
// TC is a special class cannot be included here
class iDataSerAndDeSerialize a
| gParse{|*|} // To de-serialize a string back to a value
| gParse{|*|} // To de-serialize a string back to a value
, iDataSerialize a
TraceInput :== False // set it to True if you want to see what kind of information is stored
TraceInput :== False // set it to True if you want to see what kind of information is stored