Commit 670b17ed authored by Steffen Michels's avatar Steffen Michels

added menus

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@807 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 00f695b1
......@@ -289,6 +289,9 @@ itasks.TaskFormPanel = Ext.extend(Ext.Panel, {
afterRender: function() {
itasks.TaskFormPanel.superclass.afterRender.apply(this,arguments);
this.attachTaskHandlers(this);
var tb = this.getTopToolbar();
if(tb)
this.attachTaskHandlers(tb);
},
attachTaskHandlers: function(comp) {
......@@ -332,8 +335,8 @@ itasks.TaskFormPanel = Ext.extend(Ext.Panel, {
ct.addUpdate(this.name, this.value);
ct.sendUpdates();
};
switch(comp.xtype) {
};
switch(comp.getXType()) {
case "textfield":
case "textarea":
case "numberfield":
......@@ -351,7 +354,9 @@ itasks.TaskFormPanel = Ext.extend(Ext.Panel, {
case "combo":
comp.on("select",changeTaskEvent);
case "button":
comp.on("click",clickTaskEvent);
case "menuitem":
if(comp.name)
comp.on("click",clickTaskEvent);
break;
}
......@@ -364,6 +369,8 @@ itasks.TaskFormPanel = Ext.extend(Ext.Panel, {
//attach recursively
if(comp.items && comp.items.each)
comp.items.each(this.attachTaskHandlers, this);
if(comp.menu)
this.attachTaskHandlers(comp.menu);
},
attachDocumentLinkInformation: function() {
......
......@@ -28,6 +28,7 @@ import Newsgroups
import ChangeHandling
//import WebShop
//import ideExample
import textEditor
//Crisis response examples
import AmbulanceDispatch
......@@ -53,6 +54,7 @@ where
, guiDemoExample
, bugReportExample
, coffeemachineExample
, textEditor
, newsgroupsExample
, exceptionHandlingExample
, changeHandlingExample
......
......@@ -20,22 +20,22 @@ calculateSum
calculateSumSteps :: Task Int
calculateSumSteps = step1First
where
step1First = enterInformationA "Enter a number" [] [ActionNext]
step1First = enterInformationA "Enter a number" [] [ActionNext] []
>>= \(_,num1) -> step2First num1
step1Back num1 = updateInformationA "Enter a number" [] [ActionNext] num1
step1Back num1 = updateInformationA "Enter a number" [] [ActionNext] [] num1
>>= \(_,num1`) -> step2First num1`
step2First num1 = enterInformationA "Enter another number" [ActionPrevious] [ActionNext]
step2First num1 = enterInformationA "Enter another number" [ActionPrevious] [ActionNext] []
>>= \(action,num2) -> case action of
ActionPrevious = step1Back num1
ActionNext = step3 num1 num2
step2Back num1 num2 = updateInformationA "Enter another number" [ActionPrevious] [ActionNext] num2
step2Back num1 num2 = updateInformationA "Enter another number" [ActionPrevious] [ActionNext] [] num2
>>= \(action,num2`) -> case action of
ActionPrevious = step1Back num1
ActionNext = step3 num1 num2`
step3 num1 num2 = let sum = (num1 + num2) in
showMessageAboutA "The sum of those numbers is:" [ActionPrevious,ActionOk] sum
showMessageAboutA "The sum of those numbers is:" [ActionPrevious,ActionOk] [] sum
>>= \action -> case action of
ActionPrevious = step2Back num1 num2
ActionOk = return sum
......
definition module textEditor
import iTasks
textEditor :: [Workflow]
\ No newline at end of file
implementation module textEditor
import iTasks, CommonDomain, StdMisc, Text
derive bimap Maybe, (,)
:: FileName :== String
:: TextFile = { fileId :: !(DBRef TextFile)
, name :: FileName
, content :: Note
}
derive gPrint TextFile
derive gParse TextFile
derive gVisualize TextFile
derive gUpdate TextFile
instance DB TextFile where
databaseId = mkDBid "TextFiles"
getItemId file = file.fileId
setItemId id file = {file & fileId = id}
storeFile :: FileName Note -> Task TextFile
storeFile name txt =
dbCreateItem
>>= \file. dbUpdateItem {file & name = name, content = txt}
>>= \file. return file
getFile :: (DBRef TextFile) -> Task TextFile
getFile id =
dbReadItem id
>>= \res. case res of
Nothing = undef
(Just file) = return file
getAllFileNames :: Task [((DBRef TextFile), FileName)]
getAllFileNames =
dbReadAll
>>= \files. return (map (\f -> (f.fileId, f.TextFile.name)) files)
:: AppState = AppState Note (Maybe TextFile)
derive gPrint AppState
derive gParse AppState
derive gVisualize AppState
derive gUpdate AppState
open :: AppState Note -> Task AppState
open st=:(AppState _ file) ntxt =
getAllFileNames
>>= \files. if (isEmpty files)
( showMessage "No files to open!"
>>| return (AppState ntxt file)
)
( enterChoiceA "Open File" [ActionCancel] [ActionOk] [] files
>>= \(action,(id,name)). case action of
ActionOk = addToRecentlyOpened name id
>>| openFile id st ntxt
_ = return (AppState ntxt file)
)
openFile :: (DBRef TextFile) AppState Note -> Task AppState
openFile id _ _ =
getFile id
>>= \file. return (AppState file.content (Just file))
save :: AppState Note -> Task AppState
save (AppState otxt (Just file)) ntxt =
dbUpdateItem {file & content = ntxt}
>>= \file. return (AppState ntxt (Just file))
save st txt = saveAs st txt
saveAs :: AppState Note -> Task AppState
saveAs (AppState otxt file) ntxt =
enterInformationA "Save As: enter name" [ActionCancel] [ActionOk] []
>>= \(action,name). case action of
ActionOk = storeFile name ntxt
>>= \file. return (AppState file.content (Just file))
_ = return (AppState ntxt file)
:: Replace = { searchFor :: String
, replaceWith :: String
}
derive gPrint Replace
derive gParse Replace
derive gVisualize Replace
derive gUpdate Replace
replaceT :: AppState Note -> Task AppState
replaceT (AppState _ file) (Note txt) =
enterInformationA "Replace..." [ActionCancel] [ActionOk] []
>>= \(action, v). case action of
ActionOk = return (AppState (Note (replaceSubString v.searchFor v.replaceWith txt)) file)
_ = return (AppState (Note txt) file)
about :: Task Void
about = showMessage "iTextEditor V0.01"
initState :: Task AppState
initState = return (AppState (Note "") Nothing)
addToRecentlyOpened :: String (DBRef TextFile) -> Task Void
addToRecentlyOpened name (DBRef id) =
getMenuItem "recOpened"
>>= \item. case item of
Just (SubMenu label entries) = setMenuItem "recOpened" (SubMenu label (take 5[MenuItem name (ActionParam "openFile" (toString id)):entries]))
_ = return Void
textEditorApp :: Task Void
textEditorApp = initState >>= textEditor`
where
textEditor` st=:(AppState txt file) =
updateInformationA title [] [] actions txt
>>= \(action, ntxt). case action of
ActionNew = initState >>= textEditor`
ActionOpen = open st ntxt >>= textEditor`
ActionParam "openFile" fid = openFile (DBRef (toInt fid)) st ntxt >>= textEditor`
ActionSave = save st ntxt >>= textEditor`
ActionSaveAs = saveAs st ntxt >>= textEditor`
ActionLabel "replace" = replaceT st ntxt >>= textEditor`
ActionShowAbout = about >>| return (AppState ntxt file) >>= textEditor`
_ = return Void
where
title = case file of
Nothing = "New Text Document"
(Just f) = f.TextFile.name
actions = [ (ActionNew, always)
, (ActionOpen, always)
, (ActionParam "openFile" "?", always)
, (ActionSave, (\_ _ -> isJust file))
, (ActionSaveAs, always)
, (ActionQuit, always)
, (ActionLabel "replace", (\(Note val) _ -> val <> ""))
, (ActionShowAbout, always)
]
initTextEditor :: Task Void
initTextEditor = setMenus
[ Menu "File" [ MenuItem "New" ActionNew
, MenuItem "Open..." ActionOpen
, MenuName "recOpened" (SubMenu "Recently Opened" [])
, MenuSeparator
, MenuItem "Save" ActionSave
, MenuItem "Save As..." ActionSaveAs
, MenuSeparator
, MenuItem "Quit" ActionQuit
]
, Menu "Edit" [ MenuItem "Replace..." (ActionLabel "replace") ]
, Menu "Help" [ MenuItem "About" ActionShowAbout ]
]
textEditor :: [Workflow]
textEditor = [{ name = "Examples/Miscellaneous/Text Editor"
, label = "Text Editor"
, roles = []
, mainTask = initTextEditor >>| textEditorApp
}]
\ No newline at end of file
definition module InteractionTasks
from TSt import :: Task
from Types import :: Role
from Html import :: HtmlTag
from iTasks import class iTask(..)
from TSt import :: Task
from Types import :: Role
from Html import :: HtmlTag
from iTasks import class iTask(..)
from ProcessDB import :: Action
import GenPrint, GenParse, GenVisualize, GenUpdate
// This type class contains types that may be used as
......@@ -18,71 +19,59 @@ where
instance html String
instance html [HtmlTag]
//Action buttons, you can use those to specify interactions with multiple possible actions
:: Action
= ActionLabel !String
| ActionIcon !String !String
| ActionOk
| ActionCancel
| ActionYes
| ActionNo
| ActionNext
| ActionPrevious
| ActionFinish
derive gVisualize Action
derive gUpdate Action
derive gPrint Action
derive gParse Action
:: ActionPredicate a :== a Bool -> Bool
always :: ActionPredicate a | iTask a
ifValid :: ActionPredicate a | iTask a
//*** Input tasks ***//
enterInformation :: question -> Task a | html question & iTask a
enterInformationA :: question [Action] [Action] -> Task (!Action,!a) | html question & iTask a
enterInformation :: question -> Task a | html question & iTask a
enterInformationA :: question [Action] [Action] [(Action,ActionPredicate a)] -> Task (!Action,!a) | html question & iTask a
updateInformation :: question a -> Task a | html question & iTask a
updateInformationA :: question [Action] [Action] a -> Task (!Action,!a) | html question & iTask a
updateInformation :: question a -> Task a | html question & iTask a
updateInformationA :: question [Action] [Action] [(Action,ActionPredicate a)] a -> Task (!Action,!a) | html question & iTask a
enterInformationAbout :: question b -> Task a | html question & iTask a & iTask b
enterInformationAboutA :: question [Action] [Action] b -> Task (!Action,!a) | html question & iTask a & iTask b
enterInformationAbout :: question b -> Task a | html question & iTask a & iTask b
enterInformationAboutA :: question [Action] [Action] [(Action,ActionPredicate a)] b -> Task (!Action,!a) | html question & iTask a & iTask b
updateInformationAbout :: question b a -> Task a | html question & iTask a & iTask b
updateInformationAboutA :: question [Action] [Action] b a -> Task (!Action,!a) | html question & iTask a & iTask b
updateInformationAbout :: question b a -> Task a | html question & iTask a & iTask b
updateInformationAboutA :: question [Action] [Action] [(Action,ActionPredicate a)] b a -> Task (!Action,!a) | html question & iTask a & iTask b
requestConfirmation :: question -> Task Bool | html question
requestConfirmationAbout :: question a -> Task Bool | html question & iTask a
requestConfirmation :: question -> Task Bool | html question
requestConfirmationAbout :: question a -> Task Bool | html question & iTask a
enterChoice :: question [a] -> Task a | html question & iTask a
enterChoiceA :: question [Action] [Action] [a] -> Task (!Action,!a) | html question & iTask a
enterChoice :: question [a] -> Task a | html question & iTask a
enterChoiceA :: question [Action] [Action] [(Action,ActionPredicate a)] [a] -> Task (!Action,!a) | html question & iTask a
updateChoice :: question [a] Int -> Task a | html question & iTask a
updateChoiceA :: question [Action] [Action] [a] Int -> Task (!Action,!a) | html question & iTask a
updateChoice :: question [a] Int -> Task a | html question & iTask a
updateChoiceA :: question [Action] [Action] [(Action,ActionPredicate a)] [a] Int -> Task (!Action,!a) | html question & iTask a
enterChoiceAbout :: question b [a] -> Task a | html question & iTask a & iTask b
enterChoiceAboutA :: question [Action] [Action] b [a] -> Task (!Action,!a) | html question & iTask a & iTask b
enterChoiceAbout :: question b [a] -> Task a | html question & iTask a & iTask b
enterChoiceAboutA :: question [Action] [Action] [(Action,ActionPredicate a)] b [a] -> Task (!Action,!a) | html question & iTask a & iTask b
updateChoiceAbout :: question b [a] Int -> Task a | html question & iTask a & iTask b
updateChoiceAboutA :: question [Action] [Action] b [a] Int -> Task (!Action,!a) | html question & iTask a & iTask b
updateChoiceAbout :: question b [a] Int -> Task a | html question & iTask a & iTask b
updateChoiceAboutA :: question [Action] [Action] [(Action,ActionPredicate a)] b [a] Int -> Task (!Action,!a) | html question & iTask a & iTask b
enterMultipleChoice :: question [a] -> Task [a] | html question & iTask a
enterMultipleChoiceA :: question [Action] [a] -> Task (!Action,![a]) | html question & iTask a
enterMultipleChoice :: question [a] -> Task [a] | html question & iTask a
enterMultipleChoiceA :: question [Action] [(Action,ActionPredicate [a])] [a] -> Task (!Action,![a]) | html question & iTask a
updateMultipleChoice :: question [a] [Int] -> Task [a] | html question & iTask a
updateMultipleChoiceA :: question [Action] [a] [Int] -> Task (!Action,![a]) | html question & iTask a
updateMultipleChoice :: question [a] [Int] -> Task [a] | html question & iTask a
updateMultipleChoiceA :: question [Action] [(Action,ActionPredicate [a])] [a] [Int] -> Task (!Action,![a]) | html question & iTask a
enterMultipleChoiceAbout :: question b [a] -> Task [a] | html question & iTask a & iTask b
enterMultipleChoiceAboutA :: question [Action] b [a] -> Task (!Action,![a]) | html question & iTask a & iTask b
enterMultipleChoiceAbout :: question b [a] -> Task [a] | html question & iTask a & iTask b
enterMultipleChoiceAboutA :: question [Action] [(Action,ActionPredicate [a])] b [a] -> Task (!Action,![a]) | html question & iTask a & iTask b
updateMultipleChoiceAbout :: question b [a] [Int] -> Task [a] | html question & iTask a & iTask b
updateMultipleChoiceAboutA :: question [Action] b [a] [Int] -> Task (!Action,![a]) | html question & iTask a & iTask b
updateMultipleChoiceAbout :: question b [a] [Int] -> Task [a] | html question & iTask a & iTask b
updateMultipleChoiceAboutA :: question [Action] [(Action,ActionPredicate [a])] b [a] [Int] -> Task (!Action,![a]) | html question & iTask a & iTask b
//*** Output tasks ***//
//Show a basic message to the current user. The user can end the task after reading the message.
showMessage :: message -> Task Void | html message
showMessageA :: message [Action] -> Task Action | html message
showMessage :: message -> Task Void | html message
showMessageA :: message [Action ][(Action,ActionPredicate Void)] -> Task Action | html message
showMessageAbout :: message a -> Task Void | html message & iTask a
showMessageAboutA :: message [Action] a -> Task Action | html message & iTask a
showMessageAbout :: message a -> Task Void | html message & iTask a
showMessageAboutA :: message [Action] [(Action,ActionPredicate Void)] a -> Task Action | html message & iTask a
//Show a message to the current user. The user can not finish this task. It has to be made obsolete by another parallel task.
showStickyMessage :: message -> Task Void | html message
......
definition module MenuTasks
from ProcessDB import ::Menu, ::MenuItem
from TSt import ::Task
from Void import :: Void
import StdMaybe, GenPrint, GenParse, GenVisualize, GenUpdate
derive gParse Menu, MenuItem
derive gPrint Menu, MenuItem
derive gVisualize Menu, MenuItem
derive gUpdate Menu, MenuItem
getMenus :: Task (Maybe [Menu])
setMenus :: ![Menu] -> Task Void
removeMenus :: Task Void
setMenuItem :: !String !MenuItem -> Task Void
getMenuItem :: !String -> Task (Maybe MenuItem)
\ No newline at end of file
implementation module MenuTasks
from ProcessDB import qualified class ProcessDB(..)
from ProcessDB import qualified instance ProcessDB TSt
from ProcessDB import ::Menu(..), ::MenuItem(..), ::Process{..}
from TSt import ::Task
from Void import :: Void
import TSt, CoreCombinators, StdMisc
import StdList
derive gParse Menu, MenuItem
derive gPrint Menu, MenuItem
derive gVisualize Menu, MenuItem
derive gUpdate Menu, MenuItem
derive bimap (,), Maybe
getMenus :: Task (Maybe [Menu])
getMenus
= mkInstantTask "getMenus" getMenus`
where
getMenus` tst
#(pid, tst) = getCurrentProcess tst
#(p, tst) = ProcessDB@getProcess pid tst
= case p of
Just p = (TaskFinished p.menus, tst)
Nothing = abort "Cannot get current process!"
setMenus :: ![Menu] -> Task Void
setMenus menus
= mkInstantTask "setMenus" (setMenus` (Just menus))
removeMenus :: Task Void
removeMenus = mkInstantTask "removeMenus" (setMenus` Nothing)
setMenus` :: !(Maybe [Menu]) !*TSt -> (!TaskResult Void,!*TSt)
setMenus` menus tst
#(pid, tst) = getCurrentProcess tst
#(_, tst) = ProcessDB@updateProcess pid (\p -> {p & menus = menus}) tst
= (TaskFinished Void, tst)
setMenuItem :: !String !MenuItem -> Task Void
setMenuItem updName newItem =
getMenus
>>= \menus. case menus of
Nothing = return Void
Just menus = setMenus (updateMenus menus)
where
updateMenus menus = map updateMenu menus
updateMenu (Menu label items) = Menu label (map updateItem items)
updateItem (SubMenu label items) = SubMenu label (map updateItem items)
updateItem (MenuName name item)
| name == updName = MenuName name newItem
| otherwise = MenuName name (updateItem item)
updateItem item = item
getMenuItem :: !String -> Task (Maybe MenuItem)
getMenuItem findName =
getMenus
>>= \menus. case menus of
Nothing = return Nothing
Just menus = return (searchMenus menus)
where
searchMenus [Menu _ items:menus] = case searchItems items of
Nothing = searchMenus menus
res = res
searchMenus [] = Nothing
searchItems [item:items] = case searchItem item of
Nothing = searchItems items
res = res
searchItems [] = Nothing
searchItem (SubMenu _ items) = searchItems items
searchItem (MenuName name item)
| name == findName = Just item
| otherwise = Nothing
searchItem _ = Nothing
\ No newline at end of file
......@@ -4,7 +4,7 @@ definition module ProcessDBTasks
*/
import StdMaybe
from TSt import :: Task
from ProcessDB import :: ProcessStatus(..), :: Process(..)
from ProcessDB import :: ProcessStatus(..), :: Process(..), :: Menu
from Types import :: ProcessId, :: ProcessRef, :: TaskId
from TaskTree import :: TaskProperties, :: TaskPriority, :: TaskProgress
from Time import :: Timestamp
......
......@@ -3,7 +3,7 @@ implementation module ProcessDBTasks
import StdOverloaded, StdClass, StdInt, StdArray, StdTuple, StdList
import TSt
from ProcessDB import :: Process{..}, :: ProcessStatus(..)
from ProcessDB import :: Process{..}, :: ProcessStatus(..), :: Menu
from ProcessDB import qualified class ProcessDB(..)
from ProcessDB import qualified instance ProcessDB TSt
......
......@@ -14,7 +14,7 @@ from Time import :: Timestamp
from UserDB import qualified getUser
from ProcessDB import :: Process{..}, :: ProcessStatus(..)
from ProcessDB import :: Process{..}, :: ProcessStatus(..), :: Menu
from ProcessDB import qualified class ProcessDB(..)
from ProcessDB import qualified instance ProcessDB TSt
......
......@@ -18,6 +18,8 @@ import Engine // basic iTask system creator
, DateTimeTasks // tasks triggered by date and time
, ChangeTasks // Tasks for changing existing workflows
, MenuTasks
// Task combinators
, CoreCombinators // The core iTask combinators
, CommonCombinators // Set of additional useful iTask combinators
......@@ -52,6 +54,7 @@ from StdFunc import id, const
//Types
import Types
from TSt import :: Workflow{..}, :: Change(..), :: ChangeLifeTime(..)
from ProcessDB import :: Menu(..), :: MenuItem(..), :: Action(..)
//iTask context restriction
class iTask a
......
......@@ -11,7 +11,7 @@ userAdministration
createUserFlow :: Task Void
createUserFlow
= enterInformationA "Enter user information" [ActionCancel] [ActionOk]
= enterInformationA "Enter user information" [ActionCancel] [ActionOk] []
>>= \(action,user) -> case action of
ActionCancel = stop
ActionOk = createUser user
......@@ -20,10 +20,10 @@ createUserFlow
updateUserFlow :: Task Void
updateUserFlow
= getUsers
>>= enterChoiceA "Which user do you want to update?" [ActionCancel] [ActionNext]
>>= enterChoiceA "Which user do you want to update?" [ActionCancel] [ActionNext] []
>>= \(action1,user1) -> case action1 of
ActionCancel = stop
ActionNext = updateInformationA "Please make your changes" [ActionCancel] [ActionOk] user1
ActionNext = updateInformationA "Please make your changes" [ActionCancel] [ActionOk] [] user1
>>= \(action2,user2) -> case action2 of
ActionCancel = stop
ActionOk = updateUser user2
......@@ -32,7 +32,7 @@ updateUserFlow
deleteUserFlow :: Task Void
deleteUserFlow
= getUsers
>>= enterMultipleChoiceA "Which users do you want to delete?" [ActionCancel,ActionOk]
>>= enterMultipleChoiceA "Which users do you want to delete?" [ActionCancel,ActionOk] []
>>= \(action,users) -> case action of
ActionCancel = stop
ActionOk = allTasks [deleteUser user \\ user <- users]
......
......@@ -17,6 +17,7 @@ from Time import :: Timestamp
, properties :: !TaskProperties // The properties of the main task node of this process
, changes :: ![(!ChangeLabel,!ChangeId)] // Optionally a list of labeled changes
, changeCount :: !Int // The number of task changes that have been applied
, menus :: !(Maybe [Menu])
}
:: ProcessStatus = Active
......@@ -25,6 +26,27 @@ from Time import :: Timestamp
| Excepted
| Deleted
:: Action
= ActionLabel !String
| ActionParam !String !String
| ActionIcon !String !String