ApplicationModel subclass:#ProjectBrowser
instanceVariableNames:'knownProjects'
classVariableNames:''
poolDictionaries:''
category:'Interface-Smalltalk'
!
TreeItem subclass:#ProjectTreeItem
instanceVariableNames:'action'
classVariableNames:''
poolDictionaries:''
privateIn:ProjectBrowser
!
!ProjectBrowser class methodsFor:'interface specs'!
emptyRightCanvasSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:ProjectBrowser andSelector:#emptyRightCanvasSpec
ProjectBrowser new openInterface:#emptyRightCanvasSpec
"
<resource: #canvas>
^
#(#FullSpec
#window:
#(#WindowSpec
#name: 'NewApplication'
#layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
#label: 'NewApplication'
#min: #(#Point 10 10)
#max: #(#Point 1280 1024)
#bounds: #(#Rectangle 216 173 516 473)
#usePreferredExtent: false
)
#component:
#(#SpecCollection
#collection:
#(
#(#TextEditorSpec
#name: 'TextEditor1'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#model: #rightCanvasTextHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#isReadOnly: true
)
)
)
)
!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:ProjectBrowser andSelector:#windowSpec
ProjectBrowser new openInterface:#windowSpec
ProjectBrowser open
"
<resource: #canvas>
^
#(#FullSpec
#window:
#(#WindowSpec
#name: 'ProjectBrowser'
#layout: #(#LayoutFrame 16 0 31 0 579 0 353 0)
#label: 'ProjectBrowser'
#min: #(#Point 10 10)
#max: #(#Point 1024 768)
#bounds: #(#Rectangle 16 31 580 354)
#menu: #mainMenu
#usePreferredExtent: false
)
#component:
#(#SpecCollection
#collection:
#(
#(#MenuPanelSpec
#name: 'ToolBar1'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 32 0)
#menu: #menu
#textDefault: true
)
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
#layout: #(#LayoutFrame 0 0.0 40 0.0 0 1.0 0 1.0)
#component:
#(#SpecCollection
#collection:
#(
#(#SelectionInTreeViewSpec
#name: 'TreeList1'
#model: #selectedTreeNode
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#showRoot: false
#showDirectoryIndicatorForRoot: false
#showDirectoryIndicator: true
#valueChangeSelector: #itemSelected:
#hierarchicalList: #projectTreeHolder
#highlightMode: #label
)
#(#SubCanvasSpec
#name: 'SubCanvas1'
#hasHorizontalScrollBar: false
#hasVerticalScrollBar: false
#specHolder: #currentCanvasHolder
)
)
)
#handles: #(#Any 0.274823 1.0)
)
)
)
)
! !
!ProjectBrowser class methodsFor:'menu specs'!
mainMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:ProjectBrowser andSelector:#mainMenu
(Menu new fromLiteralArrayEncoding:(ProjectBrowser mainMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'File'
#translateLabel: true
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'New'
#translateLabel: true
#value: #newProject
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Open...'
#translateLabel: true
#value: #openProject
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Save'
#translateLabel: true
#value: #saveProject
)
#(#MenuItem
#label: 'Save As...'
#translateLabel: true
#value: #saveProjectAs
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Exit'
#translateLabel: true
#value: #closeRequest
)
) nil
nil
)
)
#(#MenuItem
#label: 'Help'
#translateLabel: true
#startGroup: #right
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Documentation'
#translateLabel: true
#value: #openDocumentation
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'About this Application'
#translateLabel: true
#value: #openAboutThisApplication
)
) nil
nil
)
)
) nil
nil
)
!
menu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:ProjectBrowser andSelector:#menu
(Menu new fromLiteralArrayEncoding:(ProjectBrowser menu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'New...'
#translateLabel: true
#isButton: true
#value: #newProject
#labelImage: #(#ResourceRetriever #Icon #newIcon)
)
#(#MenuItem
#label: 'Open...'
#translateLabel: true
#isButton: true
#value: #openProject
#labelImage: #(#ResourceRetriever #Icon #loadIcon)
)
#(#MenuItem
#label: 'SaveAs...'
#translateLabel: true
#isButton: true
#value: #saveProject
#labelImage: #(#ResourceRetriever #Icon #saveIcon)
)
) nil
nil
)
! !
!ProjectBrowser methodsFor:'aspects'!
currentCanvasHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept in the browser."
|holder|
(holder := builder bindingAt:#currentCanvasHolder) isNil ifTrue:[
builder aspectAt:#currentCanvasHolder put:(holder := ValueHolder new).
].
^ holder.
!
projectTreeHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept in the browser."
|holder|
(holder := builder bindingAt:#projectTree) isNil ifTrue:[
builder aspectAt:#projectTree put:(holder := SelectionInTree new).
holder root:self projectTree.
].
^ holder.
!
rightCanvasTextHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept in the browser."
|holder|
(holder := builder bindingAt:#rightCanvasTextHolder) isNil ifTrue:[
builder aspectAt:#rightCanvasTextHolder put:(holder := ValueHolder new).
].
^ holder.
!
selectedTreeNode
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept in the browser."
|holder|
(holder := builder bindingAt:#selectedTreeNode) isNil ifTrue:[
builder aspectAt:#selectedTreeNode put:(holder := ValueHolder new).
].
^ holder.
! !
!ProjectBrowser methodsFor:'initialization'!
postBuildWith:aBuiler
self setupCanvasForNoSelection
!
setupCanvasForNoSelection
self currentCanvasHolder value:(self class emptyRightCanvasSpec).
self rightCanvasTextHolder value:'Please select an existing,
or create a new project.'.
! !
!ProjectBrowser methodsFor:'private'!
nodeFor:aProject
|projectName pNode
propertiesNode docNode classesNode subprojectsNode filesNode
commentNode|
projectName := aProject name.
pNode := ProjectTreeItem name:projectName.
pNode contents:aProject.
pNode add:(commentNode := ProjectTreeItem name:'Comment').
pNode add:(docNode := ProjectTreeItem name:'Documentation').
pNode add:(propertiesNode := ProjectTreeItem name:'Properties').
pNode add:(classesNode := ProjectTreeItem name:'Classes').
pNode add:(subprojectsNode := ProjectTreeItem name:'SubProjects').
pNode add:(filesNode := ProjectTreeItem name:'Files').
aProject subProjects do:[:aSubProject |
subprojectsNode add:(self nodeFor:aSubProject)
].
commentNode action:[:item | self showCommentOf:item].
docNode contents:nil.
propertiesNode contents:nil.
classesNode contents:nil.
subprojectsNode contents:nil.
filesNode contents:nil.
^ pNode
!
projectTree
|tree root|
tree := SelectionInTree new.
tree root:(root := TreeItem name:'invisibleRoot').
Project knownProjects do:[:aProject |
root add:(self nodeFor:aProject).
].
^ root
!
updateRightCanvas
|selectedNode nodeContents|
selectedNode := self selectedTreeNode value.
selectedNode isNil ifTrue:[
self setupCanvasForNoSelection.
^ self
].
nodeContents := selectedNode contents.
(nodeContents isMemberOf:Project) ifTrue:[
self currentCanvasHolder value:(self class emptyRightCanvasSpec).
self rightCanvasTextHolder value:nodeContents comment.
^ self.
].
self currentCanvasHolder value:(self class emptyRightCanvasSpec).
self rightCanvasTextHolder value:''.
! !
!ProjectBrowser methodsFor:'user actions'!
itemSelected:index
|item action|
self updateRightCanvas.
item := self projectTreeHolder value at:index.
action := item action.
action notNil ifTrue:[
action value:item.
].
!
showCommentOf:anItem
|project|
project := anItem parent contents.
self currentCanvasHolder value:(self class emptyRightCanvasSpec).
self rightCanvasTextHolder value:project comment.
!
showTreeItem:anItem
anItem contents == #comment ifTrue:[
self showCommentOf:anItem.
^ self
].
! !
!ProjectBrowser::ProjectTreeItem methodsFor:'accessing'!
action
"return the value of the instance variable 'action' (automatically generated)"
^ action!
action:something
"set the value of the instance variable 'action' (automatically generated)"
action := something.! !
!ProjectBrowser class methodsFor:'documentation'!
version
^ '$Header$'
! !