Commit 36d8d4f1 authored by ecrombag's avatar ecrombag

- added (==) for TUIDefinitions, comparing only on structure and not on...

- added (==) for TUIDefinitions, comparing only on structure and not on values, preventing superfluous updates of lists when only field-values are changed.
- bugfix. When putting a recursive data structure in a list, infinite recursion occurred upon updating
- small fix in worklist panel.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1099 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent ca9ed213
......@@ -64,6 +64,8 @@ itasks.WorkListPanel = Ext.extend(Ext.Panel,{
},
buildTree : function(data){
if(!data) return;
var buildNode = function(d, isLeaf){
var newCls = (d.systemProperties.firstEvent == d.systemProperties.latestEvent)?'new-task-node':''
......@@ -87,8 +89,6 @@ itasks.WorkListPanel = Ext.extend(Ext.Panel,{
var children = [];
if(!treeData) return [];
for(var i=0; i < treeData.length; i++){
var d = treeData[i];
......
implementation module HttpServer
import Http, HttpUtil, HttpTextUtil
import StdList, StdTuple, StdArray, StdFile, StdBool, StdMisc
import StdTCP
import StdList, StdTuple, StdArray, StdFile, StdBool, StdMisc, StdMaybe
//import StdTCP
//import TCPIP
import TCPChannelClass,
TCPChannels,
TCPEvent,
TCPStringChannels,
TCPDef
//Start the HTTP server
http_startServer :: [HTTPServerOption] [(!(String -> Bool),!(HTTPRequest *World-> (!HTTPResponse,!HTTPServerControl,!*World)))] *World -> *World
......@@ -29,11 +36,11 @@ loop :: [HTTPServerOption]
*World -> *World
loop options handlers listener rchannels schannels requests world
//Join the listener with the open channels
# glue = (TCP_Listeners [listener]) :^: (TCP_RChannels rchannels)
# glue = TCP_Pair (TCP_Listeners [listener]) (TCP_RChannels rchannels)
//Select the channel which has data available
# ([(who,what):_],glue,_,world) = selectChannel_MT Nothing glue Void world
# ([(who,what):_],glue,_,world) = selectChannel_MT Nothing glue TCP_Void world
//Split the listener from the open channels
# ((TCP_Listeners [listener:_]) :^: (TCP_RChannels rchannels)) = glue
# (TCP_Pair (TCP_Listeners [listener:_]) (TCP_RChannels rchannels)) = glue
//A new client attempts to connect
| who == 0
# world = debug "New connection opened" options world
......
......@@ -219,6 +219,7 @@ gUpdate{|String|} s ust = (s, ust)
gUpdate{|Dynamic|} _ ust=:{USt|mode=UDCreate} = (dynamic 42, ust)
gUpdate{|Dynamic|} d ust = (d, ust)
import StdDebug
gUpdate{|[]|} fx _ ust=:{USt|mode=UDCreate} = ([], ust)
gUpdate{|[]|} fx l ust=:{USt|mode=UDSearch,searchPath,currentPath,update,mask}
......@@ -324,11 +325,14 @@ gUpdate{|Maybe|} fx m ust=:{USt|mode=UDSearch,currentPath,searchPath,update}
| otherwise
= case m of
Nothing
# (x,ust) = fx (abort "Maybe create with undef") {ust & mode = UDCreate} //Create an empty value to update
# (x,ust=:{mode,currentPath}) = fx x {ust & mode = UDSearch,currentPath = currentPath, searchPath = searchPath,update = update}
= case mode of
UDDone = (Just x,ust) //Only switch keep newly created value if a field was updated
_ = (Nothing, ust)
| (dataPathList searchPath) <== (dataPathList currentPath)
# (x,ust) = fx (abort "Maybe create with undef") {ust & mode = UDCreate} //Create an empty value to update
# (x,ust=:{mode,currentPath}) = fx x {ust & mode = UDSearch,currentPath = currentPath, searchPath = searchPath,update = update}
= case mode of
UDDone = (Just x,ust) //Only switch keep newly created value if a field was updated
_ = (Nothing, ust)
| otherwise
= (Nothing, ust)
Just x
# (x,ust) = fx x ust
= (Just x,ust)
......
......@@ -680,7 +680,7 @@ where
determineChanges [o:os] [] idx = [TUIUpdate (TUIRemove (itemId idx)):determineChanges os [] (idx+1)]
determineChanges [] [n:ns] idx = [TUIUpdate (TUIAdd (itemId (idx-1)) n):determineChanges [] ns (idx+1)]
determineChanges [o:os] [n:ns] idx
| o =!= n = [TUIUpdate (TUIReplace (fromJust (getId n)) n):determineChanges os ns (idx+1)]
| o <> n = [TUIUpdate (TUIReplace (fromJust (getId n)) n):determineChanges os ns (idx+1)]
| otherwise = determineChanges os ns (idx+1)
isValid val dm valid
......
......@@ -10,7 +10,9 @@ from ProcessDB import :: Hotkey
//Specialized JSON encoding of TUI definitions
derive JSONEncode TUIDef, TUIUpdate
derive gEq TUIDef
//derive gEq TUIDef
instance == TUIDef
:: TUIId :== String
......
......@@ -4,9 +4,9 @@ import JSON,StdList,StdBool,GenEq
from Types import :: Document, :: DocumentId
from ProcessDB import :: Hotkey
derive gEq TUIDef, TUIBasicControl, TUICurrencyControl, TUIDocumentControl, TUIConstructorControl, TUIButtonControl, TUIListItemControl
derive gEq TUITupleContainer, TUIRecordContainer, TUIListContainer, JSONNode, Maybe, Document
derive gEq TUIButton, TUIUpdate, TUIChoiceControl, TUIMenuButton, TUIMenu, TUIMenuItem, TUIHtmlPanel, Hotkey
//derive gEq TUIDef, TUIBasicControl, TUICurrencyControl, TUIDocumentControl, TUIConstructorControl, TUIButtonControl, TUIListItemControl
//derive gEq TUITupleContainer, TUIRecordContainer, TUIListContainer, JSONNode, Maybe, Document
//derive gEq TUIButton, TUIUpdate, TUIChoiceControl, TUIMenuButton, TUIMenu, TUIMenuItem, TUIHtmlPanel, Hotkey
//JSON Encoding of TUI definitions is directly encoded as JSON data.
derive JSONEncode TUIButton, TUIUpdate, TUIMenuButton, TUIMenu, TUIMenuItem, TUIHtmlPanel, Hotkey
......@@ -48,9 +48,6 @@ addXType :: !String ![JSONNode] -> [JSONNode]
addXType xtype [JSONObject fields: xs] = [JSONObject [("xtype", JSONString xtype):fields] : xs]
addXType xtype nodes = nodes
/**************
Not right yet..
instance == TUIDef //Compare TUI Definitions based on structure, not on their actual values
where
(==) (TUIStringControl a) (TUIStringControl b) = a == b
......@@ -74,12 +71,12 @@ where
(==) (TUIRecordContainer a) (TUIRecordContainer b) = a == b
(==) (TUIListContainer a) (TUIListContainer b) = a == b
(==) (TUIButton a) (TUIButton b) = a === b
(==) (TUIHtmlPanel a) (TUIHtmlPanel b) = a === b
(==) (TUIMenuButton a) (TUIMenuButton b) = a == b
(==) (TUIMenuItem a) (TUIMenuItem b) = a == b
(==) (TUIButton a) (TUIButton b) = True //a == b
(==) (TUIHtmlPanel a) (TUIHtmlPanel b) = True //a == b
(==) (TUIMenuButton a) (TUIMenuButton b) = True //a == b
(==) (TUIMenuItem a) (TUIMenuItem b) = True //a == b
(==) (TUIMenuSeparator) (TUIMenuSeparator) = True
(==) (TUICustom a) (TUICustom b) = a === b
(==) (TUICustom a) (TUICustom b) = True //a == b
(==) _ _ = False
......@@ -91,7 +88,9 @@ where
instance == TUIChoiceControl
where
(==) a b = a.TUIChoiceControl.id == b.TUIChoiceControl.id
(==) a b = (a.TUIChoiceControl.id == b.TUIChoiceControl.id)
&& (a.TUIChoiceControl.optional == b.TUIChoiceControl.optional)
&& (a.TUIChoiceControl.options == a.TUIChoiceControl.options)
instance == TUICurrencyControl
where
......@@ -120,6 +119,7 @@ where
instance == TUIListItemControl
where
(==) a b = a.TUIListItemControl.id == b.TUIListItemControl.id
&& (a.TUIListItemControl.items == b.TUIListItemControl.items)
instance == TUIMenuItem
where
......@@ -137,6 +137,8 @@ where
(==) a b = (a.TUIListContainer.id == b.TUIListContainer.id)
&& (a.TUIListContainer.staticDisplay == b.TUIListContainer.staticDisplay)
&& (a.TUIListContainer.items == b.TUIListContainer.items)
import StdDebug
instance == TUIRecordContainer
where
......@@ -151,5 +153,4 @@ where
instance == TUIMenu
where
(==) a b = a.TUIMenu.items == b.TUIMenu.items
**********************/
\ No newline at end of file
(==) a b = a.TUIMenu.items == b.TUIMenu.items
\ No newline at end of file
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment