*** empty log message ***

libraries/iData/iDataFormlib.dcl

@@ -7,10 +7,10 @@ import iDataButtons
 
 // **** easy creation of a simple html page ****
 
-mkHtml				:: String [BodyTag] *HSt 			-> (!Bool,Html,*HSt)	// string is used for the title of the page
-mkHtmlExcep			:: String !Bool [BodyTag] *HSt 		-> (!Bool,Html,*HSt)	// same, passes on possible exception for client
-mkHtmlB				:: String [BodyAttr] [BodyTag] *HSt -> (!Bool,Html,*HSt)	// same, with bodytags options
-simpleHtml			:: String [BodyAttr] [BodyTag]      -> Html			// as above, without HSt
+mkHtml				:: !String ![BodyTag] 					*HSt 	-> (!(!Bool,!String),Html,*HSt)	// string is used for the title of the page
+mkHtmlExcep			:: !String !(!Bool,!String) ![BodyTag] 	*HSt 	-> (!(!Bool,!String),Html,*HSt)	// same, passes on possible exception for client
+mkHtmlB				:: !String ![BodyAttr] ![BodyTag] 		*HSt 	-> (!(!Bool,!String),Html,*HSt)	// same, with bodytags options
+simpleHtml			:: !String ![BodyAttr] ![BodyTag]      			-> Html							// as above, without HSt
 
 // **** LayOut support ****
 

libraries/iData/iDataFormlib.icl

@@ -12,20 +12,20 @@ derive gForm []; derive gUpd []
 
 // easy creation of an html page
 
-mkHtml		:: String [BodyTag] *HSt -> (!Bool,Html,*HSt)
-mkHtml s tags hst 			= (False,simpleHtml s [] tags,hst)
+mkHtml		:: !String ![BodyTag] *HSt -> (!(!Bool,!String),Html,*HSt)
+mkHtml s tags hst 			= ((False,""),simpleHtml s [] tags,hst)
 
-mkHtmlExcep	:: String !Bool [BodyTag] *HSt -> (!Bool,Html,*HSt)
-mkHtmlExcep s exception tags hst = (exception,simpleHtml s [] tags,hst)
+mkHtmlExcep	:: !String !(!Bool,!String) ![BodyTag] *HSt -> (!(!Bool,!String),Html,*HSt)
+mkHtmlExcep s (exception,prefix) tags hst = ((exception,prefix),simpleHtml s [] tags,hst)
 
-simpleHtml	:: String [BodyAttr] [BodyTag] -> Html
+simpleHtml	:: !String ![BodyAttr] ![BodyTag] -> Html
 simpleHtml s ba tags	 	= Html (header s) (body tags)
 where
 	header s				= Head [`Hd_Std [Std_Title s]] [] 
 	body tags				= Body ba tags
 
-mkHtmlB		:: String [BodyAttr] [BodyTag] *HSt -> (!Bool,Html,*HSt)
-mkHtmlB s attr tags hst		= (False, simpleHtml s attr tags,hst)
+mkHtmlB		:: !String ![BodyAttr] ![BodyTag] *HSt -> (!(!Bool,!String),Html,*HSt)
+mkHtmlB s attr tags hst		= ((False,""), simpleHtml s attr tags,hst)
 
 // operators for lay-out of html bodys ...
 

libraries/iData/iDataHandler.dcl

@@ -31,11 +31,11 @@ derive write 	Inline
 
 :: Inline 		= Inline String
 
-:: UserPage 	:== .(*HSt -> .(!Bool,Html,!*HSt))
+:: UserPage 	:== .(*HSt -> .((!Bool,!String),Html,!*HSt))
 
 // doHtmlServer & doHtmlClient main wrappers for generating & handling of Html forms
 
-doHtmlWrapper		:: UserPage !*World -> *World	//Combined wrapper which starts the server or client wrapper
+doHtmlWrapper		:: !UserPage !*World -> *World	//Combined wrapper which starts the server or client wrapper
 
 // 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!

libraries/iData/iDataHandler.icl

@@ -49,13 +49,13 @@ closemDataFile datafile world
 //doHtmlServer. It switches between doHtmlServer and doHtmlClient depending on which compile option
 //is selected.
 
-doHtmlWrapper :: UserPage !*World -> *World
+doHtmlWrapper :: !UserPage !*World -> *World
 doHtmlWrapper userpage world = IF_Client (doHtmlClient userpage world) (doHtmlServer userpage world)
 
 // doHtmlServer: top level function given to end user.
 // It sets up the communication with a (sub)server or client, depending on the option chosen.
 
-doHtmlServer :: UserPage !*World -> *World
+doHtmlServer :: !UserPage !*World -> *World
 doHtmlServer userpage world
 | ServerKind == Internal
 	# world	= instructions world
@@ -117,18 +117,18 @@ doDynamicResource userpage request world
 	= ({http_emptyResponse & rsp_data = (toString html)}, world)
 
 // General entry used by all servers and client to calculate the next page
-doHtmlPage :: !HTTPRequest !.(*HSt -> (!Bool,Html,!*HSt)) !*HtmlStream !*World -> (!Bool,!*HtmlStream,!*World)
+doHtmlPage :: !HTTPRequest !.UserPage !*HtmlStream !*World -> (!Bool,!*HtmlStream,!*World)
 doHtmlPage request userpage inout world
 # (gerda,world)				= openDatabase ODCBDataBaseName world						// open the relational database if option chosen
 # (datafile,world)			= openmDataFile DataFileName world							// open the datafile if option chosen
 # nworld 					= {worldC = world, inout = inout, gerda = gerda, datafile = datafile}	
 # (initforms,nworld)	 	= retrieveFormStates request.arg_post nworld				// Retrieve the state information stored in an html page, other state information is collected lazily
 # hst						= {(mkHSt initforms nworld) & request = request}			// Create the HSt
-# (toServer,Html (Head headattr headtags) (Body bodyattr bodytags),{states,world}) 
+# ((toServer,prefix),Html (Head headattr headtags) (Body bodyattr bodytags),{states,world}) 
 							= userpage hst												// Call the user application
 # (debugOutput,states)		= if TraceOutput (traceStates states) (EmptyBody,states)	// Optional show debug information
 # (pagestate, focus, world=:{worldC,gerda,inout,datafile})	
-							= storeFormStates states world								// Store all state information
+							= storeFormStates prefix states world								// Store all state information
 # worldC					= closeDatabase gerda worldC								// close the relational database if option chosen
 # worldC					= closemDataFile datafile worldC							// close the datafile if option chosen
 # inout						= IF_Ajax
@@ -336,7 +336,7 @@ where
 
 // gForm: automatically derives a Html form for any Clean type
 
-mkForm :: !(InIDataId a) !*HSt -> *(Form a, !*HSt)	| gForm {|*|} a
+mkForm :: !(InIDataId a) *HSt -> *(Form a, !*HSt)	| gForm {|*|} a
 mkForm (init,formid) hst =: {issub}
 # (form,hst) 	= gForm{|*|} (init,formid) {hst & submits = (formid.mode == Submit), issub = True}	//Use gForm to create the html form
 # buttons		= if (formid.mode == Submit) 										 				//Add submit and clear buttons to a form in submit mode.
@@ -635,12 +635,12 @@ where
 		
 toHtml :: a -> BodyTag | gForm {|*|} a
 toHtml a
-# (na,_)						= mkForm (Set,mkFormId "__toHtml" a <@ Display) (mkHSt emptyFormStates (abort "illegal call to toHtml"))
+# (na,_)						= mkForm (Set,mkFormId "__toHtml" a <@ Display) (mkHSt emptyFormStates (abort "illegal call to toHtml!\n"))
 = 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 (abort "illegal call to toHtmlForm!\n"))
 = na.form
 
 toBody :: (Form a) -> BodyTag

libraries/iData/iDataState.dcl

@@ -27,7 +27,7 @@ changeLifetimeStates :: !String !Lifespan !Lifespan !*FormStates !*NWorld -> (!*
 // storage and retrieval of FormStates
 
 retrieveFormStates 	:: ![(!String, !String)] !*NWorld -> (!*FormStates,!*NWorld) 	// retrieves all form states hidden in the html page
-storeFormStates 	:: !FormStates !*NWorld -> (!String, !String, !*NWorld)
+storeFormStates 	:: !String !FormStates !*NWorld -> (!String, !String, !*NWorld)
 
 
 getTriplets 		:: !String !*FormStates -> (!Triplets,!*FormStates)	// retrieve triplets matching given id

libraries/iData/iDataState.icl

@@ -327,13 +327,15 @@ where
 // Serialize all states in FormStates that have to be remembered to either hidden encoded Html Code
 // or store them in a persistent file, all depending on the kind of states
 
-storeFormStates :: !FormStates !*NWorld -> (!String, !String, !*NWorld)
-storeFormStates {fstates = allFormStates, focusid = focus} world
+storeFormStates :: !String !FormStates !*NWorld -> (!String, !String, !*NWorld)
+storeFormStates prefix {fstates = allFormStates, focusid = focus} world
 # world						= writeAllTxtFileStates allFormStates world				// first write all persistens states
 # encodedpagestate			= EncodeHtmlStates (FStateToHtmlState allFormStates []) // encode states in the page
 = (encodedpagestate, focus, world)
 
 where
+	sprefix = size prefix
+
 	FStateToHtmlState :: !(Tree_ !(!String,!.FormState)) !*[HtmlState] -> *[HtmlState]
 	FStateToHtmlState Leaf_ accu	= accu
 	FStateToHtmlState (Node_ left x right) accu
@@ -350,6 +352,10 @@ where
 		htmlStateOf (fid,OldState {life=Client, format=PlainStr stringval})	= Just  (fid,Client, PlainString,stringval)
 		htmlStateOf (fid,OldState {life=Client, format=StatDyn  dynval})	= Just  (fid,Client, StaticDynamic,dynamic_to_string dynval)
 
+		htmlStateOf (fid,OldState {life=Page, format=PlainStr stringval})	
+		| prefix <> fid%(0,sprefix)											= Just  (fid,Client, PlainString,stringval) // for Ajax calls, remember states not belonging to this thread
+		htmlStateOf (fid,OldState {life=Page, format=StatDyn  dynval})	    
+		| prefix <> fid%(0,sprefix)											= Just  (fid,Client, StaticDynamic,dynamic_to_string dynval)
 		htmlStateOf (fid,OldState s)										= Nothing
 
 		// persistent stores (either old or new) have already been stored in files and can be skipped here

libraries/iTasks/iTasksHandler.dcl

@@ -19,7 +19,6 @@ derive gerda 	Void
 derive read 	Void
 derive write 	Void
 
-
 // iTask main task types:
 
 :: LabeledTask a	:== !(!TaskLabel,!Task a)		// a Task with a label used for labeling buttons, pull down menu, and the like
@@ -61,17 +60,15 @@ instance <<@		  Lifespan						// default: Session
 
 instance @>>		  SubPage						// default: the *whole* page will be updated when a form has been modified
 
-// Initiate the iTask library with an iData server wrapper such as doHtmlServer in combination with one of the following functions:
-					
 /*
 singleUserTask 	:: iTask start function for defining tasks for one, single user; intended for developing and testing
 */
-singleUserTask 	:: ![StartUpOptions] !(Task a) 				!*HSt -> (!Bool,Html,*HSt) 	| iData a
+singleUserTask 	:: ![StartUpOptions] !(Task a) !*World -> *World  	| iData a
 
 /*
 multiUserTask 	:: iTask start function for multiple -users; intended for developing and testing  
 */
-multiUserTask 	:: ![StartUpOptions] !(Task a)  			!*HSt -> (!Bool,Html,*HSt) 	| iData a
+multiUserTask 	:: ![StartUpOptions] !(Task a) !*World -> *World   	| iData a
 
 /*
 workFlowTask	:: iTask start function to create a real life workflow
@@ -79,12 +76,10 @@ workFlowTask	:: iTask start function to create a real life workflow
 						Bool: 	True, is the user a new one: if so the second argument is spawned as a separate task for that user
 						UserId:	the id of that user 
 					- the second argument is workflow that will spawned as a task 
-						(True if we have new user,user id of the user, has ) : 
 					- the second one is the actual function for that user  
 				   a predefined login task is defined as an example in iTaskLogin.dcl				
 */
-workFlowTask 	:: ![StartUpOptions] !(Task ((Bool,UserId),a)) 
-							!(UserId a -> LabeledTask b) 	!*HSt -> (!Bool,Html,*HSt) | iData b 
+workFlowTask 	:: ![StartUpOptions] !(Task ((Bool,UserId),a)) !(UserId a -> LabeledTask b) !*World -> *World   | iData b 
 
 
 /*

libraries/iTasks/iTasksHandler.icl

@@ -119,44 +119,51 @@ where   (@>>) UseAjax task			= \tst -> IF_Ajax
 // *** wrappers for the end user, to be used in combination with an iData wrapper...
 // ******************************************************************************************************
 
-singleUserTask :: ![StartUpOptions] !(Task a) !*HSt -> (!Bool,Html,*HSt) | iData a 
-singleUserTask startUpOptions maintask hst 
-# userOptions			= determineUserOptions [ThreadStorage TxtFile:startUpOptions]
-# tst					= initTst 0 Session userOptions.threadStorageLoc hst
-# (exception,html,hst)	= startTstTask 0 False (False,[]) userOptions maintask tst
-= mkHtmlExcep "singleUser" exception html hst
-
-multiUserTask :: ![StartUpOptions] !(Task a) !*HSt -> (!Bool,Html,*HSt) | iData a 
-multiUserTask startUpOptions maintask  hst 
-# userOptions 			= determineUserOptions [TestModeOff, VersionCheck, ThreadStorage TxtFile:startUpOptions] 
-# nusers				= case userOptions.showUsersOn of
-							Nothing -> 0
-							Just n	-> n
-| nusers == 0			= singleUserTask startUpOptions maintask  hst 
-# (idform,hst) 			= FuncMenu (Init,nFormId "User_Selected" 
-							(0,[("User " +++ toString i,\_ -> i) \\ i<-[0..nusers - 1] ])) hst
-# currentWorker			= snd idform.value
-# tst					= initTst currentWorker TxtFile userOptions.threadStorageLoc hst
-# (exception,html,hst) 	= startTstTask currentWorker True 
-							(if userOptions.traceOn (idform.changed,idform.form) (False,[])) userOptions maintask tst
-= mkHtmlExcep "multiUser" exception html hst
-
-workFlowTask :: ![StartUpOptions] !(Task ((Bool,UserId),a)) !(UserId a -> LabeledTask b) !*HSt -> (!Bool,Html,*HSt) | iData b 
-workFlowTask  startUpOptions taska userTask hst 
-# userOptions 			= determineUserOptions startUpOptions 
-# tst					= initTst -1 Session userOptions.threadStorageLoc hst
-# (((new,i),a),tst=:{activated,html,hst})	
-						= taska tst									// for doing the login 
-| not activated
-	# iTaskHeader		= [showHighLight "i-Task", showLabel " - Multi-User Workflow System ",Hr []]
-	# iTaskInfo			= mkDiv "iTaskInfo" [showText "Login procedure... ", Hr []]
-	= mkHtmlExcep "workFlow" True [Ajax [ ("thePage",iTaskHeader ++ iTaskInfo ++ noFilter html) // Login ritual cannot be handled by client
-										]] hst
-# userOptions 			= determineUserOptions [TestModeOff, VersionCheck, ThreadStorage TxtFile:startUpOptions] 
-# tst					= initTst i Session userOptions.threadStorageLoc hst
-# (exception,body,hst) 	= startTstTask i True (False,[]) userOptions (newUserTask ((new,i),a) <<@ TxtFile) tst
-= mkHtmlExcep "workFlow" exception body hst
+//singleUserTask :: ![StartUpOptions] !(Task a) -> UserPage  | iData a 
+singleUserTask 	:: ![StartUpOptions] !(Task a) !*World -> *World  	| iData a
+singleUserTask startUpOptions maintask world = doHtmlWrapper singleUserTask` world
 where
+	singleUserTask` hst 
+	# userOptions					= determineUserOptions [ThreadStorage TxtFile:startUpOptions]
+	# tst							= initTst 0 Session userOptions.threadStorageLoc hst
+	# (toserver_prefix,html,hst)	= startTstTask 0 False (False,[]) userOptions maintask tst
+	= mkHtmlExcep "singleUser" (toserver_prefix) html hst
+
+multiUserTask :: ![StartUpOptions] !(Task a) !*World -> *World   | iData a 
+multiUserTask startUpOptions maintask world = doHtmlWrapper multiUserTask` world
+where
+	multiUserTask` hst 
+	# userOptions 					= determineUserOptions [TestModeOff, VersionCheck, ThreadStorage TxtFile:startUpOptions] 
+	# nusers						= case userOptions.showUsersOn of
+										Nothing -> 0
+										Just n	-> n
+//	| nusers == 0			= singleUserTask startUpOptions maintask  hst 
+	# (idform,hst) 					= FuncMenu (Init,nFormId "User_Selected" 
+										(0,[("User " +++ toString i,\_ -> i) \\ i<-[0..nusers - 1] ])) hst
+	# currentWorker					= snd idform.value
+	# tst							= initTst currentWorker TxtFile userOptions.threadStorageLoc hst
+	# (toserver_prefix,html,hst) 	= startTstTask currentWorker True 
+										(if userOptions.traceOn (idform.changed,idform.form) (False,[])) userOptions maintask tst
+	= mkHtmlExcep "multiUser" (toserver_prefix) html hst
+
+workFlowTask :: ![StartUpOptions] !(Task ((Bool,UserId),a)) !(UserId a -> LabeledTask b)!*World -> *World  | iData b 
+workFlowTask  startUpOptions taska userTask world = doHtmlWrapper workFlowTask` world 
+where
+	workFlowTask` hst 
+	# userOptions 					= determineUserOptions startUpOptions 
+	# tst							= initTst -1 Session userOptions.threadStorageLoc hst
+	# (((new,i),a),tst=:{activated,html,hst})	
+									= taska tst									// for doing the login 
+	| not activated
+		# iTaskHeader				= [showHighLight "i-Task", showLabel " - Multi-User Workflow System ",Hr []]
+		# iTaskInfo					= mkDiv "iTaskInfo" [showText "Login procedure... ", Hr []]
+		= mkHtmlExcep "workFlow" (True,"") [Ajax [ ("thePage",iTaskHeader ++ iTaskInfo ++ noFilter html) // Login ritual cannot be handled by client
+											]] hst
+	# userOptions 					= determineUserOptions [TestModeOff, VersionCheck, ThreadStorage TxtFile:startUpOptions] 
+	# tst							= initTst i Session userOptions.threadStorageLoc hst
+	# (toserver_prefix,body,hst) 	= startTstTask i True (False,[]) userOptions (newUserTask ((new,i),a) <<@ TxtFile) tst
+	= mkHtmlExcep "workFlow" (toserver_prefix) body hst
+
 	noFilter :: HtmlTree -> HtmlCode
 	noFilter (BT body) 			= body
 	noFilter (_ @@: html) 		= noFilter html
@@ -186,7 +193,7 @@ where
 // *THE* main routine for the determination of the current state and the creation of a new workflow page
 // ******************************************************************************************************
 
-startTstTask :: !Int !Bool  !(!Bool,!HtmlCode) UserStartUpOptions !(Task a) !*TSt -> (!Bool,!HtmlCode,!*HSt) | iData a 
+startTstTask :: !Int !Bool  !(!Bool,!HtmlCode) UserStartUpOptions !(Task a) !*TSt -> (!(!Bool,!String),!HtmlCode,!*HSt) | iData a 
 startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceOn, threadStorageLoc, showUsersOn, versionCheckOn, headerOff, testModeOn} maintask tst=:{hst,tasknr,staticInfo}
 
 // prologue
@@ -210,7 +217,7 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
 							[Hr []]
 | versionconflict	 
 	# iTaskInfo			= mkDiv "iTaskInfo" [showLabel "Cannot apply request. Version conflict. Please refresh the page!", Hr []]
-	= (True,[Ajax [("thePage",iTaskHeader ++ iTaskInfo)]],hst)
+	= ((True,""),[Ajax [("thePage",iTaskHeader ++ iTaskInfo)]],hst)
 
 // Here the iTasks are evaluated ...
 													    
@@ -228,6 +235,7 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
 # (sversion,hst)	 	= setSVersionNr thisUser (\_ -> newUserVersionNr) hst									// store in persistent memory
 
 # showCompletePage		= IF_Ajax (hd threads == [-1]) True
+# prefix				= if showCompletePage "" (determine_prefix thisUser threads)
 # (threadtrace,tst)	
 						= if TraceThreads showThreadTable nilTable {tst & hst = hst} 
 # threadsText			= if showCompletePage "" (foldl (+++) "" [showThreadNr tasknrs +++ " + " \\ tasknrs <- reverse threads])
@@ -246,13 +254,13 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
 											 [showText "Query " , showTrace ((sversion +++> " / " )<+++ appversion)] [] ++
 										IF_Ajax
 											( [showText " - Task#: ", showTrace (showTaskNr  event)] ++
-											  if (isEmpty threads || showCompletePage) [] [showText " - Thread(s)#: ", showTrace threadsText]
+											  if (isEmpty threads || showCompletePage) [] [showText (" - Thread(s)#: "/* +++ prefix*/), showTrace threadsText]
 											 ) [] ++
 										[Br,Hr []]
 									)
 								Just userInfo -> userInfo
 # iTaskTraceInfo		=	showOptions staticInfo.threadTableLoc ++ processadmin ++ threadtrace ++ [printTrace2 trace ]
-| showCompletePage		=	(toServer,[Ajax [("thePage",	iTaskHeader ++
+| showCompletePage		=	((toServer,""),[Ajax [("thePage",	iTaskHeader ++
 															iTaskInfo  ++
 															if (doTrace && traceOn)
 																	iTaskTraceInfo
@@ -263,7 +271,7 @@ startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceO
 									] 
 							,hst)
 # (newthread,oldthreads)=	(hd threads, tl threads)
-| otherwise				=	(toServer,[Ajax (	[("iTaskInfo", iTaskInfo)] ++			// header ino
+| otherwise				=	((toServer,""),[Ajax (	[("iTaskInfo", iTaskInfo)] ++			// header ino
 											[(showTaskNr childthreads,[showText " "]) \\ childthreads <- oldthreads] ++ //clear childthreads, since parent thread don't need to be on this page
 											[(showTaskNr newthread, if (isEmpty threadcode) seltask threadcode)]	// task info
 										   )
@@ -276,6 +284,13 @@ where
 //		# world = if testModeOn deleteAllStateFiles id world
 //		= (Void,{hst & world = world})
 
+	determine_prefix:: !UserId ![TaskNr] -> String
+	determine_prefix user [] 		= ""
+	determine_prefix user [[-1]] 	= ""
+	determine_prefix user threads
+	# smallest	= hd (sortBy (\l1 l2 ->  length l1 <  length l2) (map tl threads))
+	= iTaskId user smallest ""
+
 	leftright left right 
 	=	Table [Tbl_Width (Percent 100)] 
 			[Tr []	[ Td [] left