*** empty log message ***

libraries/htmlGEC/Examples/Conf Management System/ConfManager.icl

@@ -209,7 +209,7 @@ where
 	= guestHomePage newaccount accounts hst
 	
 	guestPerson hst 		// 2. administrate personel administration
-	# (personf,hst)			= mkEditForm (Init,nFormId "cms_guest_person" createDefault) hst
+	# (personf,hst)			= mkEditForm (Init,nFormId "cms_guest_person" createDefault <@ Submit) hst
 	# (exception,hst)		= ExceptionStore ((+) (invariantPerson account.login.loginName personf.value)) hst	
 	| isJust exception		= ([Txt "2. Please fill in your personal data so that we can inform you.",Br,Br ] ++ personf.form,hst)
 	# (_,hst)				= guestSubPages Set (\_ -> GuestSubmitPaper) hst
@@ -218,7 +218,7 @@ where
 	= guestHomePage account accounts hst
 
 	guestSubmitPaper hst	// 3. handle paper submission
-	# (paperf,hst)			= mkEditForm (Init,nFormId "cms_guest_paper" createDefault) hst
+	# (paperf,hst)			= mkEditForm (Init,nFormId "cms_guest_paper" createDefault <@ Submit) hst
 	# (exception,hst)		= ExceptionStore ((+) (invariantPaper account.login.loginName paperf.value)) hst	
 	| isJust exception		= ([Txt "3. Now submit your paper.", Br, Br] ++ paperf.form,hst)
 	# (paperNr,hst)			= PaperNrStore inc hst	// now all iformation is there, make it all persistent

libraries/htmlGEC/Examples/Simple Examples/balanceTree.prj

 Version: 1.4
 Global
 	Built:	True
-	Target:	Web Applications
+	Target:	Everything
 	Exec:	{Project}\balanceTree.exe
 	CodeGen
 		CheckStacks:	False
@@ -56,11 +56,11 @@ MainModule
 	DclOpen:	False
 	Icl
 		WindowPosition
-			X:	230
-			Y:	14
+			X:	10
+			Y:	10
 			SizeX:	800
 			SizeY:	624
-	IclOpen:	True
+	IclOpen:	False
 	LastModified:	No 0 0 0 0 0 0
 OtherModules
 	Module
@@ -138,7 +138,7 @@ OtherModules
 			NeverMemoryProfile:	False
 			NeverTimeProfile:	False
 			StrictnessAnalysis:	True
-			ListTypes:	NoTypes
+			ListTypes:	StrictExportTypes
 			ListAttributes:	True
 			Warnings:	True
 			Verbose:	True
@@ -155,7 +155,7 @@ OtherModules
 			NeverMemoryProfile:	False
 			NeverTimeProfile:	False
 			StrictnessAnalysis:	True
-			ListTypes:	NoTypes
+			ListTypes:	StrictExportTypes
 			ListAttributes:	True
 			Warnings:	True
 			Verbose:	True
@@ -172,7 +172,7 @@ OtherModules
 			NeverMemoryProfile:	False
 			NeverTimeProfile:	False
 			StrictnessAnalysis:	True
-			ListTypes:	NoTypes
+			ListTypes:	StrictExportTypes
 			ListAttributes:	True
 			Warnings:	True
 			Verbose:	True
@@ -189,7 +189,7 @@ OtherModules
 			NeverMemoryProfile:	False
 			NeverTimeProfile:	False
 			StrictnessAnalysis:	True
-			ListTypes:	NoTypes
+			ListTypes:	StrictExportTypes
 			ListAttributes:	True
 			Warnings:	True
 			Verbose:	True
@@ -257,7 +257,7 @@ OtherModules
 			NeverMemoryProfile:	False
 			NeverTimeProfile:	False
 			StrictnessAnalysis:	True
-			ListTypes:	NoTypes
+			ListTypes:	StrictExportTypes
 			ListAttributes:	True
 			Warnings:	True
 			Verbose:	True
@@ -274,7 +274,7 @@ OtherModules
 			NeverMemoryProfile:	False
 			NeverTimeProfile:	False
 			StrictnessAnalysis:	True
-			ListTypes:	NoTypes
+			ListTypes:	StrictExportTypes
 			ListAttributes:	True
 			Warnings:	True
 			Verbose:	True
@@ -291,7 +291,7 @@ OtherModules
 			NeverMemoryProfile:	False
 			NeverTimeProfile:	False
 			StrictnessAnalysis:	True
-			ListTypes:	NoTypes
+			ListTypes:	StrictExportTypes
 			ListAttributes:	True
 			Warnings:	True
 			Verbose:	True
@@ -457,7 +457,7 @@ OtherModules
 				Y:	10
 				SizeX:	800
 				SizeY:	624
-		DclOpen:	False
+		DclOpen:	True
 		IclOpen:	False
 		LastModified:	No 0 0 0 0 0 0
 	Module
@@ -477,8 +477,8 @@ OtherModules
 		DclOpen:	False
 		Icl
 			WindowPosition
-				X:	143
-				Y:	-5
+				X:	84
+				Y:	8
 				SizeX:	800
 				SizeY:	624
 		IclOpen:	False
@@ -3516,23 +3516,28 @@ Static
 		Path:	{Application}\Libraries\StdLib
 		Path:	{Application}\Libraries\ObjectIO
 		Path:	{Application}\Libraries\ObjectIO\OS Windows
+		Path:	{Application}\Libraries\Directory
 		Path:	{Application}\Libraries\Dynamics\extension
 		Path:	{Application}\Libraries\Dynamics\general
 		Path:	{Application}\Libraries\Dynamics\implementation
 		Path:	{Application}\Libraries\Dynamics\implementation\windows
 		Path:	{Application}\Libraries\Generics
 		Path:	{Application}\Libraries\ArgEnvWindows
+		Path:	{Application}\Libraries\Gast
 		Path:	{Application}\Libraries\Directory
 		Path:	{Application}\Libraries\Tcp
-		Path:	{Application}\Libraries\GEC\GEC Implementation
+		Path:	{Application}\Libraries\ExceptionsWindows
+		Path:	{Application}\Libraries\MersenneTwister
+		Path:	{Application}\Libraries\WrapDebug
+		Path:	{Application}\Libraries\ExtendedArith\ExtendedArith
+		Path:	{Application}\Libraries\GameLib
 		Path:	{Application}\Libraries\htmlGEC
+		Path:	{Application}\Libraries\GEC\GEC Implementation
+		Path:	{Application}\Libraries\Hilde
+		Path:	{Application}\Libraries\GEC
 		Path:	{Application}\Libraries\htmlGEC\graph_copy
-		Path:	{Application}\Libraries\htmlGEC\htmlTest
-		Path:	{Application}\Libraries\MersenneTwister
 		Path:	{Application}\Libraries\Gerda
-		Path:	{Application}\Libraries\Hilde
 		Path:	{Application}\Libraries\Hilde\Parser combinators 2002
-		Path:	{Application}\Libraries\ExceptionsWindows
-		Path:	{Application}\Libraries\WrapDebug
-	AppP:	C:\Documents and Settings\rinus\Bureaublad\Current Work\Clean 2.1.1
-	PrjP:	C:\Documents and Settings\rinus\Bureaublad\Current Work\Clean 2.1.1\Libraries\htmlGEC\Examples\Simple Examples
+		Path:	{Application}\Libraries\ExtEnv
+	AppP:	C:\Documents and Settings\rinus\Desktop\Clean 2.1.1
+	PrjP:	C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\htmlGEC\Examples\Simple Examples

libraries/htmlGEC/Examples/Simple Workflows/date.icl

+module date
+
+import StdEnv, StdHtml
+
+// findDate will settle a date and time between two persons that want to meet
+// first a person is chosen by the person taken the initiative
+// then a date is settled by the two persons by repeatedly asking each other for a convenient date
+// if such a date is found both have to confirm the date and the task is finished
+
+npersons = 5
+
+Start world = doHtmlServer (multiUserTask npersons [] findDate) world
+
+findDate tst
+# (whomPD,tst)		= 	( 	[Txt "Choose person you want to date:",Br] 
+						?>>	STask "Set" (PullDown (1,100) (0,[toString i \\ i <- [1..npersons]]))
+					  	) 	tst
+# whom				=	toInt(toString whomPD)
+# (datetime,tst) 	= 	(	[Txt "Determining date:",Br,Br] 
+						?>> findDate` whom (Date 1 1 2007,Time 9 0 0)
+						) 	tst
+# (me,tst)			=	myId tst
+# (_,tst) 			= 	(	[]
+						?>> PTask2 (confirm me whom datetime,confirm whom me datetime) 
+						)	tst
+= (datetime,tst)
+where
+	findDate` whom daytime tst
+	# (daytime,tst) 	= proposeDateTime daytime tst
+	# ((ok,daytime),tst)= ((whom,"Meeting Request") @: determineDateTime daytime) tst
+	| ok				= returnV daytime tst
+	# (ok,tst)			= askDateTime daytime tst
+	| ok				= returnV daytime tst
+	= mkTask (findDate` whom daytime) tst
+	where
+		proposeDateTime (date,time) tst
+		# input 				= (showHtml [Txt "Propose date: "], date, showHtml [Txt "Propose time: "], time)
+		# ((_,date,_,time),tst)	= STask "Set" input tst
+		= ((date,time),tst)
+
+		determineDateTime daytime tst
+		# (ok,tst)		= askDateTime daytime tst
+		| ok			= returnV (ok,daytime) tst
+		# (daytime,tst) = proposeDateTime daytime tst
+		= returnV (ok,daytime) tst
+
+		askDateTime (date,time) tst
+		= ( [Txt ("Can we meet on the " <+++ date <+++ " at " <+++ time <+++ "?"),Br] ?>>
+			CTask_button [("Accept",returnV True),("Sorry",returnV False)]
+		  ) tst
+
+	confirm me you (date,time) tst
+	= 	(	me @::
+			(	[Txt ("Person " <+++ me <+++ " and person " <+++ you <+++ " will meet on " <+++ date <+++ " at " <+++ time),Br,Br] 
+				?>>  STask "OK" Void
+			)
+		) 	tst
+		
+		
+		
+
+
+
+

libraries/htmlGEC/Examples/Simple Workflows/deadline.icl

+module deadline
+
+import StdEnv, StdHtml
+
+derive gForm []
+derive gUpd []
+
+npersons = 5
+
+Start world = doHtmlServer (multiUserTask npersons [] (deadline mytask)) world
+
+mytask = STask "Press" 0
+
+deadline task tst
+# (whomPD,tst)		= 	( 	[Txt "Choose person you want to shift work to:",Br,Br] 
+						?>>	STask "Set" (PullDown (1,100) (0,[toString i \\ i <- [1..npersons]]))
+					  	) 	tst
+# who				=	toInt(toString whomPD)
+# (time,tst)		= 	( 	[Txt "Until what time do you want to wait today?",Br,Br] 
+						?>>	STask "SetTimer" (Time 0 0 0)
+					  	) 	tst
+# ((ok,value),tst) = 	(	[]
+						?>> shifttask who time task 
+						)	tst
+# (_,tst) 			= 	(	if ok [Txt ("Result of task: " <+++ value),Br,Br] [Txt "Task Expired !",Br,Br]
+						?>> STask "OK" Void
+						)	tst
+= (value,tst)
+where
+	shifttask who time task tst
+		= ((who,"Timed Task") 	
+				@: 	PCTask2	
+					(	waitForTimeTask time 								// wait for deadline
+						#>> returnV (False,createDefault)					// return default
+					, 	[Txt ("Please finish task before" <+++ time),Br,Br]	// tell deadline
+						?>> (task =>> \v -> returnV (True,v))				// do task and return its result
+					) 
+			) tst
+
+
+

libraries/htmlGEC/Examples/Simple Workflows/sum.icl

+module sum
+
+import StdEnv, StdHtml
+
+// choose one of the following variants
+
+Start world = doHtmlServer (singleUserTask count) world
+// Start world = doHtmlServer (multiUserTask 3 [] countMU) world
+// Start world = doHtmlServer (multiUserTask 3 [setTaskAttribute Persistent] countMU) world
+
+count tst
+# (v1,tst) 	= STask "Set" initVal tst
+# (v2,tst) 	= STask "Set" initVal tst
+# tst		= returnF [Hr []] tst
+= returnTask (v1 + v2) tst
+
+countMU tst
+# (v1,tst) 	= ((1,"number") @: STask "Set" initVal) tst	// user 1
+# (v2,tst) 	= ((2,"number") @: STask "Set" initVal) tst	// user 2
+# tst		= returnF [Hr []] tst						// user 0
+= returnTask (v1 + v2) tst								// user 0
+
+// Change the type to any type one can apply addition to
+
+initVal :: Int
+initVal = createDefault
+

libraries/htmlGEC/Examples/Simple Workflows/travel.icl

+module travel
+
+import StdEnv, StdHtml
+
+derive gForm []
+derive gUpd []
+
+Start world = doHtmlServer (singleUserTask travel) world
+
+travel tst
+# (booked,tst)= PCTask2
+					( STasks 
+						[	( "Choose Booking options"
+							, MCTask_ckbox	[ ("Book_Flight",BookFlight)
+											, ("Book_Hotel", BookHotel)
+											, ("Book_Car",   BookCar)
+											]
+							)
+						, 	( "Booking confirmation"
+							, STask_button "Confirm" (returnV [])
+							)
+						]
+					, STask_button "Cancel" (returnV [])
+					) tst
+| isNil	booked	= returnTask "Cancelled" tst
+# (_,tst)		= STask "Pay" (Dsp (calcCosts booked)) tst
+= returnTask "Paid" tst
+where
+	BookFlight tst 	= STask "BookFlight" 	(Dsp "Flight Number","",Dsp "Costs",0) tst
+	BookHotel tst 	= STask "BookHotel" 	(Dsp "Hotel Name","",Dsp "Costs",0) tst
+	BookCar tst 	= STask "BookCar" 		(Dsp "Car Brand","",Dsp "Costs",0) tst
+
+	Pay booked bookings tst		= returnTask "OK" tst	
+
+	calcCosts booked = sum [cost \\ (_,_,_,cost) <- hd booked]
+
+	isNil [] = True
+	isNil _ = False
+
+Dsp = DisplayMode 

libraries/htmlGEC/Examples/Simple Workflows/workflowExamples.icl

@@ -9,7 +9,7 @@ derive gUpd []
 //Start world = doHtmlServer (multiUser twotasks3) world
 
 
-Start world = doHtmlServer (multiUser agenda2) world
+Start world = doHtmlServer (singleUser CoffeeMachineInf) world
 where
 	singleUser tasks hst 
 	# (_,html,hst) = startTask 0 tasks hst
@@ -26,6 +26,7 @@ where
 //		# tst	= setTaskAttribute Persistent tst
 //		# tst	= setTaskAttribute StaticDynamic tst
 //		# tst	= setTaskAttribute Database tst
+//		# tst	= setTaskAttribute Submit tst
 		= tasks tst
 
 
@@ -35,9 +36,19 @@ list tst
 # (a,tst) = returnTask a tst
 = (a,tst)
 
+onetwo tst
+# (v,tst) = STasks  [ ("First", 	simple 1 |>> (\n -> n > 100, \_ -> "Value should be larger than 100") 
+								=>> (\t -> returnTask t))
+					, ("Second",	simple 2 
+								=>> (\t -> returnTask t))
+					] tst
+= STask "Klaar"  (sum v) tst
+
 testEenTwee tst
-# (v,tst) = STasks  [ ("een", (1,"number1") @: simple 1 =>> \t -> returnTask t)
-					, ("twee",(2,"number2") @: simple 2 =>> \t -> returnTask t)
+# (v,tst) = STasks  [ ("een", (1,"number1") @: 	simple 1 |>> (\n -> n > 100,\_ -> "Value should be larger than 100") 
+											=>> \t -> returnTask t)
+					, ("twee",(2,"number2") @: 	simple 2 
+											=>> \t -> returnTask t)
 					] tst
 = STask "Klaar"  (sum v) tst
 

libraries/htmlGEC/PrintUtil.icl

@@ -66,10 +66,10 @@ htmlCmnd		:: !a !b -> FoF | gHpr{|*|} a & gHpr{|*|} b
 htmlCmnd		hdr txt			= \file -> closeCmnd hdr (openCmnd hdr "" file <+ txt)
 
 openCmnd		:: !a !b -> FoF | gHpr{|*|} a & gHpr{|*|} b
-openCmnd		hdr attr		= \file -> [|"<":file]  <+ hdr <+ attr <+ ">"
+openCmnd		hdr attr		= \file -> [|"\r<":file]  <+ hdr <+ attr <+ ">"
 
 closeCmnd		:: !a -> FoF | gHpr{|*|} a
-closeCmnd		hdr				= \file -> print "</" file <+ hdr <+ ">"
+closeCmnd		hdr				= \file -> print "\r</" file <+ hdr <+ ">"
 
 htmlAttrCmnd	:: !hdr !attr !body -> FoF | gHpr{|*|} hdr & gHpr{|*|} attr & gHpr{|*|} body
 htmlAttrCmnd	hdr attr txt	= \file -> closeCmnd hdr (openCmnd hdr attr file <+ txt)

libraries/htmlGEC/htmlButtons.dcl

@@ -10,7 +10,7 @@ derive gForm 	(,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, But
 derive gUpd  	(,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML, PasswordBox
 derive gPrint 	(,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML, PasswordBox
 derive gParse 	(,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML, PasswordBox
-derive gerda 	(,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, PasswordBox
+derive gerda 	(,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML, PasswordBox
 
 instance toBool		CheckBox, Button, RadioButton	// True if checkbox checked, button pressed
 instance toInt		PullDownMenu					// Current index in pull down list

libraries/htmlGEC/htmlButtons.icl

@@ -31,6 +31,7 @@ gParse{|HTML|} st					= case gParse {|*|} st of
 										Just "XYX" -> Just (HTML [EmptyBody])
 										_          -> Just (HTML [EmptyBody])
 
+gerda{|HTML|}  = undef
 
 // Tuples are placed next to each other, pairs below each other ...
 layoutTableAtts	:== [Tbl_CellPadding (Pixels 0), Tbl_CellSpacing (Pixels 0)]	// default table attributes for arranging layout

libraries/htmlGEC/htmlDataDef.icl

@@ -3,10 +3,10 @@ implementation module htmlDataDef
 import StdStrictLists, StdString
 import htmlStyleDef, htmlStylelib
 
-gHpr{|Html|}    prev (Html head rest)			= prev <+ head <+ rest 
+gHpr{|Html|}    prev (Html head rest)			= prev <+ htmlbegin <+ head <+ rest <+ htmlend 
 where
 	htmlbegin									= "<html>"
-	htmlend 									= "</html>/n/n"
+	htmlend 									= "</html>"
 
 gHpr{|Head|}    prev (Head attr tags)			= prev <+> htmlAttrCmnd "head"			attr tags
 

libraries/htmlGEC/htmlFormlib.icl

@@ -29,7 +29,10 @@ mkHtmlB s attr tags hst		= (simpleHtml s attr tags,hst)
 // Place two bodies next to each other
 
 (<=>) infixl 5   :: [BodyTag] [BodyTag] -> BodyTag
-(<=>) b1 b2					= (BodyTag b1) <.=.> (BodyTag b2)
+(<=>) [] []				= EmptyBody
+(<=>) [] b2				= BodyTag b2
+(<=>) b1 []				= BodyTag b1
+(<=>) b1 b2				= (BodyTag b1) <.=.> (BodyTag b2)
 
 (<.=.>) infixl 5 :: BodyTag BodyTag -> BodyTag
 (<.=.>) b1 b2				=  STable [Tbl_CellPadding (Pixels 0), Tbl_CellSpacing (Pixels 0)] [[b1,b2]]
@@ -40,6 +43,9 @@ mkHtmlB s attr tags hst		= (simpleHtml s attr tags,hst)
 (<||>) b1 b2				= (BodyTag b1) <.||.> (BodyTag b2)
 
 (<|.|>) infixl 4 :: [BodyTag] [BodyTag] -> [BodyTag]	// Place a above b
+(<|.|>) [] []				= []
+(<|.|>) [] b2				= b2
+(<|.|>) b1 []				= b1
 (<|.|>) b1 b2				= [(BodyTag b1) <.||.> (BodyTag b2)]
 
 

libraries/htmlGEC/htmlSettings.dcl

@@ -11,7 +11,7 @@ class iData a							// The collection of generic functions needed to make iData:
 		
 class iDataSerialize a
 		| gPrint{|*|}			//		To serialize a value to a String
-		, gerda {|*|} 			//		OPTION: To store and retrieve a value in a database
+//		, 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
@@ -21,6 +21,8 @@ class iDataSerAndDeSerialize a
 TraceInput			:== False			// show what kind of information is received from Client
 TraceOutput			:== False			// show what kind of information is stored
 
+DEBUGSERVER			:== True			// show what kind of information is transmitted by the Clean HtmlServer
+
 MyDataBase			:== "iDataDatabase"	// name of database being used by iData applications
 
 iDataIdSeparator 	 :== "."			// used as separator when combining iData form id's
@@ -28,5 +30,5 @@ radioButtonSeparator :== '.'			// used as extension for family of radiobuttons
 
 // OPTIONS WHICH CAN BE SET OFF AND ON
 
-IF_GERDA gerda no_gerda :== gerda		// If database option is used
-//IF_GERDA gerda no_gerda :== no_gerda	// otherwise, BUT manually flag of ", gerda{|*|}" in the class definition above
+//IF_GERDA gerda no_gerda :== gerda		// If database option is used
+IF_GERDA gerda no_gerda :== no_gerda	// otherwise, BUT manually flag of ", gerda{|*|}" in the class definition above

libraries/htmlGEC/htmlTask.dcl

@@ -22,17 +22,20 @@ multiUserTask 	:: wrapper for [0..users - 1], optional set of global Task attrib
 */
 startTask 		:: !Int !(Task a) HSt -> (a,[BodyTag],HSt) 			  | iData a 
 singleUserTask 	:: !(Task a) 					 !*HSt -> (Html,*HSt) | iData a 
-multiUserTask 	:: !Int !(Task a) [*TSt -> *TSt] !*HSt -> (Html,*HSt) | iData a 
+multiUserTask 	:: !Int [*TSt -> *TSt] !(Task a)  !*HSt -> (Html,*HSt) | iData a 
 /* Global Attribute settings: iTask are by default Lifespan = Session, StorageFormt = PlainString
 For multi user systems 
 */
 class setTaskAttribute a :: !a *TSt -> *TSt
 
-instance setTaskAttribute Lifespan, StorageFormat
+instance setTaskAttribute Lifespan, StorageFormat, Mode
 
 /* Assign tasks with informative name to user with indicated id
+(@:)			:: will prompt who is waiting for what
+(@::)			:: no prompting
 */
-(@:) infix 0 :: !(!Int,!String) (Task a)	-> (Task a)			| iData a
+(@:)  infix 1 	:: !(!Int,!String) (Task a)	-> (Task a)			| iData a
+(@::) infix 1 	:: !Int (Task a)		    -> (Task a)			| iData a
 
 /* Promote any TSt state transition function to an iTask:
 mkTask			:: function will only be called when it is its turn to be activated
@@ -90,7 +93,8 @@ returnV 		:: a 					-> (Task a) 			| iData a
 returnTask 		:: a 					-> (Task a) 			| iData a 
 returnVF 		:: a [BodyTag] 			-> (Task a) 			| iData a 
 returnF 		:: [BodyTag] 			-> TSt -> TSt
-(?>>) infix 3 :: [BodyTag] v:(St TSt .a) -> v:(St TSt .a)
+(?>>) infix 0 	:: [BodyTag] v:(St TSt .a) -> v:(St TSt .a)
+myId			:: TSt -> (Int,TSt)
 
 /* Setting up communication channels between users:
 mkRTask			:: Remote Task: split indicated task in two tasks: a calling task and a receiving task
@@ -125,3 +129,4 @@ appHSt 			:: (HSt -> (a,HSt)) TSt -> (a,TSt)
 
 (=>>) infix 2 :: w:(St .s .a) v:(.a -> .(St .s .b)) -> u:(St .s .b), [u <= v, u <= w]	// `bind`
 (#>>) infix 1 :: w:(St .s .a) v:(St .s .b) -> u:(St .s .b), [u <= v, u <= w]			// `bind` ignoring argument
+(|>>) infix 3 :: (*TSt -> *(a,*TSt)) (a -> .Bool,a -> String) -> .(*TSt -> *(a,*TSt)) | iData a		// repeat as long as predicate does not hold

libraries/htmlGEC/htmlTask.icl

@@ -19,6 +19,7 @@ import dynamic_string, EncodeDecode
 					}
 :: Storage		=	{ tasklife		:: !Lifespan
 					, taskstorage	:: !StorageFormat
+					, taskmode		:: !Mode
 					}
 
 :: HtmlTree		=	BT [BodyTag]
@@ -42,17 +43,18 @@ startTask thisUser taska hst
 							, myId		= defaultUser 
 							, html 		= defaultUser @@: BT []
 							, hst 		= hst
-							, storageInfo = {tasklife = Session, taskstorage = PlainString }}
+							, storageInfo = {tasklife = Session, taskstorage = PlainString, taskmode = Edit }}
 # (pversion,hst)	 	= mkStoreForm (Init, pFormId userVersionNr 0) inc hst
 # (sversion,hst)	 	= mkStoreForm (Init, nFormId sessionVersionNr pversion.value) inc hst
-= (a,refresh.form ++ [Br,Br, Hr [],Br] <|.|> Filter thisUser defaultUser html,hst)
+= (a,refresh.form ++ [Br,Br, Hr [],Br] <|.|> Filter ((==) thisUser) defaultUser html,hst)
 where
-	Filter thisUser user (BT bdtg) 			= if (thisUser == user) bdtg []
-	Filter thisUser user (nuser @@: tree) 	= Filter thisUser nuser tree
-	Filter thisUser user (tree1 +|+ tree2)  = Filter thisUser user tree1 <|.|> Filter thisUser user tree2
-	Filter thisUser user (tree1 +-+ tree2)  = [Filter thisUser user tree1 <=> Filter thisUser user tree2]
-
 	defaultUser	= 0
+
+Filter pred user (BT bdtg) 			= if (pred user) bdtg []
+Filter pred user (nuser @@: tree) 	= Filter pred nuser tree
+Filter pred user (tree1 +|+ tree2)  = Filter pred user tree1 <|.|> Filter pred user tree2
+Filter pred user (tree1 +-+ tree2)  = [Filter pred user tree1 <=> Filter pred user tree2]
+
 // options settings
 
 instance setTaskAttribute Lifespan
@@ -61,13 +63,16 @@ where setTaskAttribute lifespan tst = {tst & storageInfo.tasklife = lifespan}
 instance setTaskAttribute StorageFormat
 where setTaskAttribute storageformat tst = {tst & storageInfo.taskstorage = storageformat}
 
+instance setTaskAttribute Mode
+where setTaskAttribute mode tst = {tst & storageInfo.taskmode = mode}
+
 singleUserTask :: !(Task a) !*HSt -> (Html,*HSt) | iData a 
 singleUserTask task hst 
 # (_,html,hst) = startTask 0 task hst
 = mkHtml "stest" html hst
 
-multiUserTask :: !Int !(Task a) [*TSt -> *TSt] !*HSt -> (Html,*HSt) | iData a 
-multiUserTask nusers task attr hst 
+multiUserTask :: !Int [*TSt -> *TSt] !(Task a)  !*HSt -> (Html,*HSt) | iData a 
+multiUserTask nusers attr task  hst 
 # (idform,hst) 	= FuncMenu (Init,nFormId "pdm_chooseWorker" 
 						(0,[("User " +++ toString i,\_ -> i) \\ i<-[0..nusers - 1] ])) hst
 # currentWorker	= snd idform.value
@@ -78,26 +83,39 @@ where
 	# tst	= seq attr tst