ApplicationModel subclass:#ProjectBrowser
instanceVariableNames:'projectTree'
classVariableNames:''
poolDictionaries:''
category:'Interface-Smalltalk'
!
TreeItem subclass:#ProjectTreeItem
instanceVariableNames:'action'
classVariableNames:''
poolDictionaries:''
privateIn:ProjectBrowser
!
ProjectBrowser::ProjectTreeItem subclass:#ProjectNode
instanceVariableNames:''
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
)
)
)
)
!
rightCanvasSpecForEditableText
"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: false
)
)
)
)
!
rightCanvasSpecForReadOnlyText
"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 216 0 173 0 779 0 495 0)
#label: 'ProjectBrowser'
#min: #(#Point 10 10)
#max: #(#Point 1024 768)
#bounds: #(#Rectangle 216 173 780 496)
#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
#menu: #itemMenuHolder
#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.379433 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
#enabled: #hasProjectSelectedHolder
)
#(#MenuItem
#label: 'Save As...'
#translateLabel: true
#value: #saveProjectAs
#enabled: #hasProjectSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Exit'
#translateLabel: true
#value: #closeRequest
)
) nil
nil
)
)
#(#MenuItem
#label: 'Project'
#translateLabel: true
#submenuChannel: #projectItemMenu
)
#(#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
)
!
projectItemMenu
"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:#projectItemMenu
(Menu new fromLiteralArrayEncoding:(ProjectBrowser projectItemMenu)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#label: 'Rename...'
#translateLabel: true
#value: #renameProject
#enabled: #hasProjectSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'New SubProject'
#translateLabel: true
#value: #newSubProject
#enabled: #hasProjectSelectedHolder
)
#(#MenuItem
#label: '-'
)
#(#MenuItem
#label: 'Remove...'
#translateLabel: true
#value: #removeProject
#enabled: #hasProjectSelectedHolder
)
) 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.
!
hasProjectSelectedHolder
^ [
self hasProjectNodeSelected
]
!
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.
^ super postBuildWith:aBuiler
!
setupCanvasForNoSelection
self showReadOnlyText:'Please select an existing,
or create a new project.'.
! !
!ProjectBrowser methodsFor:'menus'!
itemMenu
self hasProjectNodeSelected ifTrue:[
^ self class projectItemMenu
].
^ nil
!
itemMenuHolder
^ [ self itemMenu]
! !
!ProjectBrowser methodsFor:'private'!
hasProjectNodeSelected
|selectedNode|
selectedNode := self selectedTreeNode value.
selectedNode isNil ifTrue:[^ false].
^ selectedNode isProjectNode
!
nodeFor:aProject
"generate and return a treeNode for some project"
|projectName pNode
propertiesNode docNode classesNode subprojectsNode filesNode
commentNode prerequisitesNode|
projectName := aProject name.
pNode := ProjectNode 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:(prerequisitesNode := ProjectTreeItem name:'Prerequisites').
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].
commentNode contents:#comment.
docNode contents:#documentation.
propertiesNode contents:#properties.
prerequisitesNode contents:#prerequisites.
subprojectsNode contents:#subprojects.
filesNode contents:#files.
^ pNode
!
projectTree
|tree root|
projectTree isNil ifTrue:[
tree := SelectionInTree new.
tree root:(root := TreeItem name:'invisibleRoot').
Project knownProjects do:[:aProject |
root add:(self nodeFor:aProject).
].
projectTree := root.
].
^ projectTree
!
updateRightCanvas
|selectedNode nodeContents|
selectedNode := self selectedTreeNode value.
selectedNode isNil ifTrue:[
self setupCanvasForNoSelection.
^ self
].
selectedNode isProjectNode ifTrue:[
self showCommentOf:selectedNode.
^ 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.
].
!
newProject
|newNode newProject|
newProject := Project new.
newNode := self nodeFor:newProject.
projectTree add:newNode.
self projectTreeHolder root:projectTree.
!
newSubProject
|selectedNode subNode newNode parentProject newProject|
self hasProjectNodeSelected ifTrue:[
selectedNode := self selectedTreeNode value.
parentProject := selectedNode contents.
newProject := Project new.
newNode := self nodeFor:newProject.
parentProject addSubProject:newProject.
subNode := selectedNode children detect:[:child | child contents == #subprojects].
subNode add:newNode.
self projectTreeHolder root:projectTree.
]
!
removeSubProject
|projectToRemove selectedNode subNode newNode parentProject newProject|
self hasProjectNodeSelected ifTrue:[
selectedNode := self selectedTreeNode value.
projectToRemove := selectedNode contents.
selectedNode parentNode isProjectNode.
parentProject addSubProject:newProject.
subNode := selectedNode children detect:[:child | child contents == #subprojects].
subNode add:newNode.
self projectTreeHolder root:projectTree.
]
!
showCommentOf:anItem
|projectItem project|
anItem contents == #comment ifTrue:[
projectItem := anItem parent
] ifFalse:[
projectItem := anItem
].
project := projectItem contents.
self currentCanvasHolder value:(self class rightCanvasSpecForEditableText).
self rightCanvasTextHolder value:project comment.
!
showReadOnlyText:someText
self currentCanvasHolder value:(self class rightCanvasSpecForReadOnlyText).
self rightCanvasTextHolder value:someText.
!
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::ProjectTreeItem methodsFor:'queries'!
isProjectNode
^ false
! !
!ProjectBrowser::ProjectNode methodsFor:'queries'!
isProjectNode
^ true
! !
!ProjectBrowser class methodsFor:'documentation'!
version
^ '$Header$'
! !