diff -r 26ebad245428 -r 3a75844e668a ProjectBrowser.st --- 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 + " + + + + ^ + + #(#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 + " + + + + ^ + + #(#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 + " + + + + ^ + + #(#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 + " + + + + + ^ #( + #(#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.