--- a/ProjectBrowser.st Mon Feb 22 20:40:18 1999 +0100
+++ b/ProjectBrowser.st Mon Feb 22 22:06:01 1999 +0100
@@ -1,4 +1,4 @@
-ApplicationModel subclass:#ProjectBrowser
+ToolApplicationModel subclass:#ProjectBrowser
instanceVariableNames:'projectTree'
classVariableNames:''
poolDictionaries:''
@@ -67,6 +67,53 @@
)
!
+rightCanvasSpecForClassList
+ "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:#rightCanvasSpecForClassList
+ ProjectBrowser new openInterface:#rightCanvasSpecForClassList
+ "
+
+ <resource: #canvas>
+
+ ^
+
+ #(#FullSpec
+ #window:
+ #(#WindowSpec
+ #name: 'NewApplication'
+ #layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
+ #level: 0
+ #label: 'NewApplication'
+ #min: #(#Point 10 10)
+ #max: #(#Point 1280 1024)
+ #bounds: #(#Rectangle 216 173 516 473)
+ #usePreferredExtent: false
+ )
+ #component:
+ #(#SpecCollection
+ #collection:
+ #(
+ #(#DataSetSpec
+ #name: 'classTable'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #dataList: #classList
+ #has3Dsepartors: false
+ #columnHolder: #classTableColumns
+ #columnAdaptor: #classTableAdaptor
+ )
+ )
+ )
+ )
+!
+
rightCanvasSpecForEditableText
"This resource specification was automatically generated
by the UIPainter of ST/X."
@@ -112,6 +159,50 @@
)
!
+rightCanvasSpecForHTMLText
+ "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:#rightCanvasSpecForHTMLText
+ ProjectBrowser new openInterface:#rightCanvasSpecForHTMLText
+ "
+
+ <resource: #canvas>
+
+ ^
+
+ #(#FullSpec
+ #window:
+ #(#WindowSpec
+ #name: 'NewApplication'
+ #layout: #(#LayoutFrame 216 0 173 0 515 0 472 0)
+ #level: 0
+ #label: 'NewApplication'
+ #min: #(#Point 10 10)
+ #max: #(#Point 1280 1024)
+ #bounds: #(#Rectangle 216 173 516 473)
+ #usePreferredExtent: false
+ )
+ #component:
+ #(#SpecCollection
+ #collection:
+ #(
+ #(#HTMLViewSpec
+ #name: 'HTMLBrowser1'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #model: #htmlDocumentURLHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ )
+ )
+ )
+ )
+!
+
rightCanvasSpecForReadOnlyText
"This resource specification was automatically generated
by the UIPainter of ST/X."
@@ -179,6 +270,7 @@
#(#WindowSpec
#name: 'ProjectBrowser'
#layout: #(#LayoutFrame 216 0 173 0 779 0 495 0)
+ #level: 0
#label: 'ProjectBrowser'
#min: #(#Point 10 10)
#max: #(#Point 1024 768)
@@ -198,7 +290,7 @@
)
#(#VariableHorizontalPanelSpec
#name: 'VariableHorizontalPanel1'
- #layout: #(#LayoutFrame 0 0.0 40 0.0 0 1.0 0 1.0)
+ #layout: #(#LayoutFrame 0 0.0 40 0.0 0 1.0 -24 1.0)
#component:
#(#SpecCollection
#collection:
@@ -207,6 +299,7 @@
#name: 'TreeList1'
#model: #selectedTreeNode
#menu: #itemMenuHolder
+ #performer: #itemMenuPerformer
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
@@ -227,6 +320,12 @@
)
#handles: #(#Any 0.379433 1.0)
)
+ #(#UISubSpecification
+ #name: 'infoBarSubSpec'
+ #layout: #(#LayoutFrame 0 0.0 -24 1 0 1.0 0 1.0)
+ #majorKey: #ToolApplicationModel
+ #minorKey: #windowSpecForInfoBar
+ )
)
)
)
@@ -426,10 +525,114 @@
) nil
nil
)
+!
+
+subProjectsItemMenu
+ "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:#subProjectsItemMenu
+ (Menu new fromLiteralArrayEncoding:(ProjectBrowser subProjectsItemMenu)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #label: 'New SubProject'
+ #translateLabel: true
+ #value: #newSubProject
+ #enabled: #hasSubProjectsSelectedHolder
+ )
+ ) nil
+ nil
+ )
+! !
+
+!ProjectBrowser class methodsFor:'tableColumns specs'!
+
+classTableColumns
+ "This resource specification was automatically generated
+ by the DataSetBuilder of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the DataSetBuilder may not be able to read the specification."
+
+ "
+ DataSetBuilder new openOnClass:ProjectBrowser andSelector:#classTableColumns
+ "
+
+ <resource: #tableColumns>
+
+
+ ^ #(
+ #(#DataSetColumnSpec
+ #label: 'Class'
+ #id: 'classColumn'
+ #labelAlignment: #left
+ #model: #classNameFromClassInfo:
+ )
+ #(#DataSetColumnSpec
+ #label: 'Included'
+ #id: 'inclusion'
+ #columnAlignment: #center
+ #width: 100
+ #editorType: #ComboList
+ #model: #classIncludeConditionFromClassInfo:
+ )
+ #(#DataSetColumnSpec
+ #label: 'Filename'
+ #labelAlignment: #left
+ #minWidth: 200
+ #model: #classFilenameFromClassInfo:
+ )
+ )
! !
!ProjectBrowser methodsFor:'aspects'!
+classList
+ "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:#classList) isNil ifTrue:[
+ builder aspectAt:#classList put:(holder := List new).
+ ].
+ ^ holder.
+!
+
+classTableAdaptor
+ ^ self
+!
+
+classTableColumns
+ "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:#classTableColumns) isNil ifTrue:[
+ builder aspectAt:#classTableColumns put:(holder := ValueHolder new).
+ ].
+ ^ holder.
+!
+
currentCanvasHolder
"automatically generated by UIPainter ..."
@@ -451,6 +654,27 @@
]
!
+hasSubProjectsSelectedHolder
+ ^ [
+ self hasSubProjectsNodeSelected
+ ]
+!
+
+htmlDocumentURLHolder
+ "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:#htmlDocumentURLHolder) isNil ifTrue:[
+ builder aspectAt:#htmlDocumentURLHolder put:(holder := ValueHolder new).
+ ].
+ ^ holder.
+!
+
projectTreeHolder
"automatically generated by UIPainter ..."
@@ -515,12 +739,19 @@
self hasProjectNodeSelected ifTrue:[
^ self class projectItemMenu
].
+ self hasSubProjectsNodeSelected ifTrue:[
+ ^ self class subProjectsItemMenu
+ ].
^ nil
!
itemMenuHolder
^ [ self itemMenu]
+!
+
+itemMenuPerformer
+ ^ self
! !
!ProjectBrowser methodsFor:'private'!
@@ -535,6 +766,16 @@
!
+hasSubProjectsNodeSelected
+ |selectedNode|
+
+ selectedNode := self selectedTreeNode value.
+ selectedNode isNil ifTrue:[^ false].
+
+ ^ selectedNode contents == #subprojects
+
+!
+
nodeFor:aProject
"generate and return a treeNode for some project"
@@ -562,6 +803,9 @@
commentNode contents:#comment.
docNode contents:#documentation.
+ docNode action:[:item | self showDocumentationFor:item].
+
+ classesNode contents:#classes.
propertiesNode contents:#properties.
@@ -605,11 +849,23 @@
^ self.
].
+ selectedNode contents == #classes ifTrue:[
+ self showClassListOf:selectedNode.
+ ^ self.
+ ].
+
self currentCanvasHolder value:(self class emptyRightCanvasSpec).
self rightCanvasTextHolder value:''.
! !
+!ProjectBrowser methodsFor:'private - table col access'!
+
+classNameFromClassInfo:cInfo
+Transcript showCR:'xxx'.
+ self halt.
+! !
+
!ProjectBrowser methodsFor:'user actions'!
itemSelected:index
@@ -625,9 +881,13 @@
!
newProject
- |newNode newProject|
+ self newProject:Project new.
+
+!
- newProject := Project new.
+newProject:newProject
+ |newNode|
+
newNode := self nodeFor:newProject.
projectTree add:newNode.
self projectTreeHolder root:projectTree.
@@ -635,38 +895,107 @@
!
newSubProject
- |selectedNode subNode newNode parentProject newProject|
+ |selectedNode subProjectsNode newNode parentProject newProject|
+
+ selectedNode := self selectedTreeNode value.
self hasProjectNodeSelected ifTrue:[
- selectedNode := self selectedTreeNode value.
parentProject := selectedNode contents.
-
+ subProjectsNode := selectedNode children detect:[:child | child contents == #subprojects].
+ ] ifFalse:[
+ self hasSubProjectsNodeSelected ifTrue:[
+ subProjectsNode := selectedNode.
+ parentProject := selectedNode parent contents.
+ ].
+ ].
+self halt.
+ parentProject notNil ifTrue:[
newProject := Project new.
newNode := self nodeFor:newProject.
parentProject addSubProject:newProject.
- subNode := selectedNode children detect:[:child | child contents == #subprojects].
- subNode add:newNode.
+ subProjectsNode add:newNode.
self projectTreeHolder root:projectTree.
+ self projectTreeHolder selectNode:newNode.
+ ]
+!
+
+openProject
+ |fn newProject|
+
+ fn := Dialog
+ requestFileName:'filename:'
+ default:nil
+ ifFail:nil
+ pattern:'*.prj'
+ fromDirectory:(FileSelectionBox lastFileSelectionDirectory).
+
+ fn notNil ifTrue:[
+ newProject := Project new loadFromProjectFile:fn.
+ newProject notNil ifTrue:[
+ self newProject:newProject
+ ]
]
!
-removeSubProject
- |projectToRemove selectedNode subNode newNode parentProject newProject|
+removeProject
+ |projectToRemove selectedNode subNode newNode parentNode parentProject newProject|
self hasProjectNodeSelected ifTrue:[
selectedNode := self selectedTreeNode value.
projectToRemove := selectedNode contents.
- selectedNode parentNode isProjectNode.
+"/ parentNode := selectedNode parent.
+"/ parentNode contents == #subprojects ifTrue:[
+"/ parentNode removeChild:selectedNode.
+"/ ] ifFalse:[
+"/ parentNode removeChild:selectedNode.
+"/ ].
+ self projectTreeHolder removeSelection
+
+"/ self projectTreeHolder root:projectTree.
+
+"/ parentProject addSubProject:newProject.
+"/ subNode := selectedNode children detect:[:child | child contents == #subprojects].
+"/ subNode add:newNode.
+"/ self projectTreeHolder root:projectTree.
+ ]
+!
+
+renameProject
+ |nm selectedNode selectedProject|
+
+ self hasProjectNodeSelected ifTrue:[
+ selectedNode := self selectedTreeNode value.
+ selectedProject := selectedNode contents.
- parentProject addSubProject:newProject.
- subNode := selectedNode children detect:[:child | child contents == #subprojects].
- subNode add:newNode.
- self projectTreeHolder root:projectTree.
+ nm := Dialog
+ request:'Rename to:'
+ initialAnswer:selectedProject name.
+
+ nm size > 0 ifTrue:[
+ selectedProject name:nm.
+ selectedNode name:nm.
+ selectedNode changed.
+ ]
]
!
+showClassListOf:anItem
+ |projectItem project classInfo l|
+
+ projectItem := anItem parent.
+ project := projectItem contents.
+
+ classInfo := project classInfo.
+ l := self classList.
+ l removeAll.
+ l addAll:classInfo.
+self halt.
+
+ self currentCanvasHolder value:(self class rightCanvasSpecForClassList).
+!
+
showCommentOf:anItem
|projectItem project|
@@ -682,6 +1011,20 @@
!
+showDocumentationFor:anItem
+ |projectItem project|
+
+ anItem contents == #documentation ifTrue:[
+ projectItem := anItem parent
+ ] ifFalse:[
+ projectItem := anItem
+ ].
+ project := projectItem contents.
+
+ self currentCanvasHolder value:(self class rightCanvasSpecForHTMLText).
+ self htmlDocumentURLHolder value:project documentationURL.
+!
+
showReadOnlyText:someText
self currentCanvasHolder value:(self class rightCanvasSpecForReadOnlyText).
self rightCanvasTextHolder value:someText.