Added double buffering mechanism for hiding slow form updates

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@345 63da3aa8-80fd-4f01-9db8-e6ea747a3da2

iData/HSt.dcl

@@ -11,6 +11,7 @@ from Http import :: HTTPRequest
 from StdFile import class FileSystem
 
 :: *HSt 		= { cntr 	:: !Int 			// counts position in expression
+				  , prefix	:: !String			// global prefix used in all generated html id's
 				  , request :: !HTTPRequest		// to enable access to the current HTTP request	
 				  , states	:: !*FormStates  	// all form states are collected here ... 
 				  , world	:: *NWorld			// to enable all kinds of I/O
@@ -23,13 +24,14 @@ appWorldHSt			:: !.(*World -> *World)       !*HSt -> *HSt						// enabling World
 accWorldHSt			:: !.(*World -> *(.a,*World)) !*HSt -> (.a,!*HSt)				// enabling World operations on HSt
 
 // Create a new HSt
-mkHSt :: HTTPRequest *FormStates *NWorld -> *HSt
+mkHSt :: String HTTPRequest *FormStates *NWorld -> *HSt
 
 // Access on the HSt structure
 
 getHStCntr				:: !*HSt -> (!Int,!*HSt)										// HSt.cntr
 setHStCntr				:: !Int !*HSt -> *HSt											// HSt.cntr := HSt.cntr
 incrHStCntr				:: !Int !*HSt -> *HSt											// HSt.cntr := HSt.cntr + n
+setHStPrefix			:: !String !*HSt -> *HSt
 
 // Explicit removal of all (Persistent) IData for with the same prefix IData form id
 // Change lifespan of all IData with the same prefix IData form id

iData/HSt.icl

@@ -35,8 +35,8 @@ accWorldHSt f hst=:{world}
 	= (a,{hst & world=world})
 
 // Create a new HSt
-mkHSt :: HTTPRequest *FormStates *NWorld -> *HSt
-mkHSt request states nworld = {cntr=0, states=states, request= request, world=nworld }
+mkHSt :: String HTTPRequest *FormStates *NWorld -> *HSt
+mkHSt prefix request states nworld = {cntr=0, prefix = prefix, states=states, request= request, world=nworld }
 
 // Access on the HSt structure
 getHStCntr :: !*HSt -> (!Int,!*HSt)
@@ -48,6 +48,10 @@ setHStCntr i hst					= {hst & cntr = i}
 incrHStCntr :: !Int !*HSt -> *HSt
 incrHStCntr i hst					= {hst & cntr = hst.cntr + i}
 
+setHStPrefix :: !String !*HSt -> *HSt
+setHStPrefix s hst = {hst & prefix = s}
+
+
 // It can be convenient to explicitly delete IData, in particular for persistent IData object
 // or to optimize iTasks
 // All IData objects administrated in the state satisfying the predicate will be deleted, no matter where they are stored.

iData/iDataForms.icl

@@ -26,7 +26,7 @@ gPrint{|(->)|} gArg gRes _ _	= abort "functions can only be used with dynamic st
 // TODO: Try to make it do just a little less :)
 
 mkViewForm :: !(InIDataId d) !(HBimap d v) !*HSt -> (Form d,!*HSt) | iData v
-mkViewForm (init,formid) bm=:{toForm, updForm, fromForm, resetForm} hst=:{request,states,world}
+mkViewForm (init,formid) bm=:{toForm, updForm, fromForm, resetForm} hst=:{prefix, request,states,world}
 	| init == Const	&& formid.FormId.lifespan <> LSTemp
 	= mkViewForm (init,{FormId| formid & lifespan = LSTemp}) bm hst			// constant i-data are never stored
 	| init == Const															// constant i-data, no look up of previous value
@@ -52,10 +52,10 @@ where
 			   , form			= []
 			   , inputs			= []
 			   }
-			  , mkHSt request states world)
+			  , mkHSt prefix request states world)
 	
 		# (viewform,{states,world})											// make a form for it
-								= mkForm (init,if (init == Const) vformid (reuseFormId formid view)) (mkHSt request states world)
+								= mkForm (init,if (init == Const) vformid (reuseFormId formid view)) (mkHSt prefix request states world)
 	
 		| viewform.changed && not isupdated						 			// important: redo it all to handle the case that a user defined specialisation is updated !!
 								= calcnextView True (Just viewform.Form.value) states world
@@ -67,7 +67,7 @@ where
 			, form				= viewform.form
 			, inputs			= viewform.inputs
 			}
-		  ,mkHSt request states world)
+		  ,mkHSt prefix request states world)
 
 	replaceState` vformid view states world
 		| init <> Const			= setState vformid view states world
@@ -418,19 +418,19 @@ derive gUpd (,), (,,), (,,,), Void
 
 // gForm: automatically derives a Html form for any Clean type
 mkForm :: !(InIDataId a) *HSt -> *(Form a, !*HSt)	| gForm {|*|} a
-mkForm (init, formid =: {issub}) hst
+mkForm (init, formid =: {issub}) hst =:{prefix}
 	# (form, hst)	= gForm{|*|} (init, formid) hst
 	| issub			= (form, hst) //Subforms are contained in the <form> tags of their parent
 	| otherwise		= ({form &
-						form = [FormTag [IdAttr formid.id] form.form]
+						form = [FormTag [IdAttr (prefix +++ formid.id)] form.form]
 					   }, hst)
 	
 	
 //The basic building blocks for creating inputs
 mkInput :: !(InIDataId d) String String !*HSt -> ([HtmlTag], [InputId],*HSt) 
-mkInput (init,formid=:{mode}) type val hst=:{cntr} 
+mkInput (init,formid=:{mode}) type val hst=:{cntr,prefix} 
 	| mode == Edit || mode == Submit
-		# inputid	= (formid.id +++ "-" +++ toString cntr)
+		# inputid	= (prefix +++ formid.id +++ "-" +++ toString cntr)
 		= ( [InputTag 	[ TypeAttr		"text"
 						, ValueAttr		val
 						, NameAttr		inputid
@@ -449,8 +449,8 @@ mkInput (init,formid=:{mode}) type val hst=:{cntr}
 	
 	
 mkButton :: !(InIDataId d) String String !*HSt -> ([HtmlTag],[InputId],*HSt)
-mkButton (init, formid =: {mode}) type label hst =: {cntr} 
-	# inputid = (formid.id +++ "-" +++ toString cntr)
+mkButton (init, formid =: {mode}) type label hst =: {cntr,prefix} 
+	# inputid = (prefix +++ formid.id +++ "-" +++ toString cntr)
 	= ( [ButtonTag	[ NameAttr	inputid
 					, IdAttr	inputid
 					, TypeAttr	"button"
@@ -460,8 +460,8 @@ mkButton (init, formid =: {mode}) type label hst =: {cntr}
 	  , setHStCntr (cntr + 1) hst)
 
 mkSelect :: !(InIDataId d) String String [(String,String)] !*HSt -> ([HtmlTag],[InputId],*HSt)
-mkSelect (init, formid=:{mode}) type val options hst =:{cntr}
-	# inputid = (formid.id +++ "-" +++ toString cntr)
+mkSelect (init, formid=:{mode}) type val options hst =:{cntr,prefix}
+	# inputid = (prefix +++ formid.id +++ "-" +++ toString cntr)
 	= ( [SelectTag	[ NameAttr	inputid
 					, IdAttr	inputid
 					: if (mode == Display) [DisabledAttr] []
@@ -470,8 +470,8 @@ mkSelect (init, formid=:{mode}) type val options hst =:{cntr}
 	  , setHStCntr (cntr + 1) hst)
 
 mkCheckBox :: !(InIDataId d) String Bool !*HSt -> ([HtmlTag],[InputId],*HSt)
-mkCheckBox (init, formid=:{mode}) type val hst =:{cntr}
-	# inputid = (formid.id +++ "-" +++ toString cntr)
+mkCheckBox (init, formid=:{mode}) type val hst =:{cntr,prefix}
+	# inputid = (prefix +++ formid.id +++ "-" +++ toString cntr)
 	= ( [InputTag	[ NameAttr	inputid
 					, IdAttr	inputid
 					, TypeAttr	"checkbox"
@@ -483,7 +483,7 @@ mkCheckBox (init, formid=:{mode}) type val hst =:{cntr}
 // The following two functions are not an example of decent Clean programming, but it works thanks to lazy evaluation...
 toHtml :: a -> HtmlTag | gForm {|*|} a
 toHtml a
-	# (na,_)	= mkForm (Set,mkFormId "__toHtml" a <@ Display) (mkHSt http_emptyRequest (mkFormStates [] []) dummy)
+	# (na,_)	= mkForm (Set,mkFormId "__toHtml" a <@ Display) (mkHSt "" http_emptyRequest (mkFormStates [] []) dummy)
 	= BodyTag [] na.form
 where
 	dummy = { worldC 	= abort "dummy world for toHtml!\n"
@@ -493,7 +493,7 @@ where
 
 toHtmlForm :: !(*HSt -> *(Form a,*HSt)) -> [HtmlTag] | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
 toHtmlForm anyform 
-	# (na,hst)	= anyform (mkHSt http_emptyRequest (mkFormStates [] []) (abort "illegal call to toHtmlForm!\n"))
+	# (na,hst)	= anyform (mkHSt "" http_emptyRequest (mkFormStates [] []) (abort "illegal call to toHtmlForm!\n"))
 	= na.form
 where
 	dummy = { worldC 	= abort "dummy world for toHtmlForm!\n"

iData/iDataWidgets.icl

@@ -79,8 +79,8 @@ gForm{|HtmlButton|} (init,formid) hst
 where
 	(HtmlButton l t)	= formid.ival
 
-gForm{|HtmlCheckbox|} (init,formid =: {mode}) hst =:{cntr}
-	# inputid			= formid.id +++ "-" +++ toString cntr
+gForm{|HtmlCheckbox|} (init,formid =: {mode}) hst =:{cntr,prefix}
+	# inputid			= prefix +++ formid.id +++ "-" +++ toString cntr
 	= ({ changed		= False
 	   , value			= formid.ival
 	   , form			= [InputTag [ TypeAttr "checkbox"
@@ -104,8 +104,8 @@ gForm{|HtmlSelect|} (init,formid) hst
 where
 	(HtmlSelect o v)	= formid.ival
 
-gForm{|HtmlTextarea|} (init,formid =: {mode}) hst =:{cntr}
-# inputid = formid.id +++ "-" +++ toString cntr
+gForm{|HtmlTextarea|} (init,formid =: {mode}) hst =:{cntr,prefix}
+# inputid = prefix +++ formid.id +++ "-" +++ toString cntr
 = (	{ changed			= False
 	, value				= formid.ival
 	, form				= [TextareaTag	[ NameAttr inputid
@@ -119,8 +119,8 @@ gForm{|HtmlTextarea|} (init,formid =: {mode}) hst =:{cntr}
 where
 	(HtmlTextarea rows val) = formid.ival
 
-gForm{|HtmlPassword|} (init,formid =: {mode}) hst =: {cntr} 	
-	#inputid = formid.id +++ "-" +++ toString cntr
+gForm{|HtmlPassword|} (init,formid =: {mode}) hst =: {cntr,prefix} 	
+	#inputid = prefix +++ formid.id +++ "-" +++ toString cntr
 
 	= ({ changed		= False
 	   , value			= formid.ival

iTasks/Framework/Handlers/WorkTabHandler.icl

@@ -13,6 +13,7 @@ derive JSONEncode TabContent, TaskStatus, InputId, UpdateEvent, HtmlState, Stora
 				  , error			:: Maybe String		//Optional error if something went wrong on the server
 				  , html			:: String			//The HTML content of the tab
 				  , inputs			:: [InputId]		//The interactive inputs in the tab
+				  , prefix			:: String			//The prefix string which is prepended to all html id's of the inputs in the tab
 				  , state			:: [HtmlState]		//The task state that must be stored in the tab
 				  , activeTasks		:: Maybe [String]	//Optional list of task id's to sync the open tabs with the known states on the server
 				  , stateTrace		:: Maybe String		//Optional state trace info
@@ -25,6 +26,7 @@ derive JSONEncode TabContent, TaskStatus, InputId, UpdateEvent, HtmlState, Stora
 */
 handleWorkTabRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
 handleWorkTabRequest mainTask request session hst
+	# hst											= setHStPrefix prefix hst
 	# (toServer, htmlTree, maybeError, _, _, hst)	= calculateTaskTree thisUserId traceOn False False mainTask hst // calculate the TaskTree given the id of the current user
 	# (taskStatus,html,inputs)						= determineTaskForTab thisUserId taskId htmlTree				// filter out the code and inputs to display in this tab
 	# (htmlstates,hst)								= getPageStates hst												// Collect states that must be temporarily stored in the browser
@@ -50,6 +52,7 @@ handleWorkTabRequest mainTask request session hst
 		,	error			= maybeError
 		,	html 			= toString (DivTag [IdAttr ("itasks-tab-" +++ taskId)] html)
 		,	inputs			= inputs
+		,	prefix			= prefix
 		,	state			= htmlstates
 		,	activeTasks		= activeTasks
 		,	stateTrace		= stateTrace
@@ -62,6 +65,7 @@ where
 	thisUserId			= session.Session.userId										// fetch user id from the session
 	taskId 				= http_getValue "taskid" request.arg_get "error"				// fetch task id of the tab selecetd
 	traceOn				= http_getValue "trace" request.arg_post "" == "1"
+	prefix				= http_getValue "prefix" request.arg_post ""					// prepend a prefix to inputs when asked
 
 	mbStateTrace req states
 		| traceOn

iTasks/Framework/Startup.icl

@@ -131,7 +131,7 @@ initHSt request world
 	# updates					= decodeFormUpdates request.arg_post						// Get the form updates from the post
 	# states					= decodeHtmlStates request.arg_post							// Fetch stored states from the post
 	# fstates	 				= mkFormStates states updates 								
-	= mkHSt request fstates nworld
+	= mkHSt "" request fstates nworld
 where
 	decodeFormUpdates :: ![(!String, !String)] -> [FormUpdate]
 	decodeFormUpdates args = [update \\ (Just update) <- map mbUpdate args]