--- a/ProjectBrowser.st Sat Oct 02 15:27:55 1999 +0200
+++ b/ProjectBrowser.st Sun Oct 03 18:55:05 1999 +0200
@@ -1849,7 +1849,7 @@
#name: 'ProjectBrowser'
#min: #(#Point 10 10)
#max: #(#Point 1024 768)
- #bounds: #(#Rectangle 10 20 613 571)
+ #bounds: #(#Rectangle 509 332 1112 883)
#menu: #mainMenu
#icon: #bigProjectBrowserIcon
)
@@ -1862,47 +1862,59 @@
#menu: #menu
#textDefault: true
)
- #(#VariableHorizontalPanelSpec
- #name: 'VariableHorizontalPanel1'
- #layout: #(#LayoutFrame 0 0.0 40 0.0 0 1.0 -24 1.0)
- #handles:
- #(#OrderedCollection
- #Any 0.379433
- 1.0
- )
+ #(#VariableVerticalPanelSpec
+ #name: 'VariableVerticalPanel1'
+ #layout: #(#LayoutFrame 0 0.0 32 0.0 0 1.0 -24 1.0)
+ #level: 1
#component:
#(#SpecCollection
#collection: #(
- #(#SelectionInTreeViewSpec
- #name: 'TreeList1'
- #model: #selectedTreeNodeHolder
- #menu: #itemMenuHolder
- #performer: #itemMenuPerformer
- #hasHorizontalScrollBar: true
- #hasVerticalScrollBar: true
- #miniScrollerHorizontal: true
- #showRoot: false
- #showDirectoryIndicatorForRoot: false
- #showDirectoryIndicator: true
- #valueChangeSelector: #itemSelected:
- #doubleClickSelector: #itemDoubleClicked:
- #hierarchicalList: #projectTreeHolder
- #selectConditionSelector: #selectionChangeAllowed:
- #highlightMode: #label
+ #(#VariableHorizontalPanelSpec
+ #name: 'VariableHorizontalPanel1'
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#SelectionInTreeViewSpec
+ #name: 'TreeList1'
+ #model: #selectedTreeNodeHolder
+ #menu: #itemMenuHolder
+ #performer: #itemMenuPerformer
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #showRoot: false
+ #showDirectoryIndicatorForRoot: false
+ #showDirectoryIndicator: true
+ #valueChangeSelector: #itemSelected:
+ #doubleClickSelector: #itemDoubleClicked:
+ #hierarchicalList: #projectTreeHolder
+ #selectConditionSelector: #selectionChangeAllowed:
+ #highlightMode: #label
+ )
+ #(#SubCanvasSpec
+ #name: 'SubCanvas1'
+ #hasHorizontalScrollBar: false
+ #hasVerticalScrollBar: false
+ #specHolder: #currentCanvasHolder
+ )
+ )
+
+ )
+ #handles: #(#Any 0.389718 1.0)
)
- #(#SubCanvasSpec
- #name: 'SubCanvas1'
- #hasHorizontalScrollBar: false
- #hasVerticalScrollBar: false
- #specHolder: #currentCanvasHolder
+ #(#ArbitraryComponentSpec
+ #name: 'ArbitraryComponent1'
+ #hasBorder: false
)
)
)
+ #handles: #(#Any 0.987879 1.0)
)
#(#UISubSpecification
#name: 'infoBarSubSpec'
#layout: #(#LayoutFrame 0 0.0 -24 1 0 1.0 0 1.0)
+ #level: 1
#majorKey: #ToolApplicationModel
#minorKey: #windowSpecForInfoBar
)
@@ -2122,6 +2134,33 @@
#value: #checkInProject
#enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
)
+ #(#MenuItem
+ #label: '-'
+ )
+ #(#MenuItem
+ #label: 'CheckIn Classes'
+ #translateLabel: true
+ #value: #checkInAllClasses
+ #enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
+ )
+ #(#MenuItem
+ #label: 'CheckIn Extensions'
+ #translateLabel: true
+ #value: #checkInMethods
+ #enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
+ )
+ #(#MenuItem
+ #label: 'CheckIn Project File'
+ #translateLabel: true
+ #value: #checkInProjectFile
+ #enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
+ )
+ #(#MenuItem
+ #label: 'CheckIn Makefiles'
+ #translateLabel: true
+ #value: #checkInMakefiles
+ #enabled: #hasProjectSelectedAndProjectFilenameHolderAndProjectCodeIsLoaded
+ )
)
nil
nil
@@ -2277,6 +2316,24 @@
#translateLabel: true
#value: #browseMethodFull
)
+ #(#MenuItem
+ #label: '-'
+ )
+ #(#MenuItem
+ #label: 'Remove...'
+ #translateLabel: true
+ #value: #removeMethod
+ )
+ #(#MenuItem
+ #label: 'Remove from Project...'
+ #translateLabel: true
+ #value: #removeMethodFromProject
+ )
+ #(#MenuItem
+ #label: 'Move to Project...'
+ #translateLabel: true
+ #value: #moveMethodToProject
+ )
)
nil
nil
@@ -4055,6 +4112,20 @@
"Modified: / 23.3.1999 / 14:18:38 / cg"
!
+selectedMethod
+ |node methodInfo classOrClassName cls mthd text|
+
+ self hasMethodNodeSelected ifFalse:[^ nil].
+
+ node := self selectedTreeNode.
+ methodInfo := node contents value.
+ mthd := methodInfo method.
+ mthd isNil ifTrue:[
+ self valueOfInfoLabel value:'The method is not (yet) loaded.'.
+ ].
+ ^ mthd
+!
+
updateProjectTree
|tree moduleRoots root showWhat|
@@ -4262,44 +4333,8 @@
!ProjectBrowser methodsFor:'user actions'!
-addClass
- "ask fo, and add a single class"
-
- |p className cls|
-
- p := self currentProject.
-
- className := Dialog request:'Class to add:'.
- className size == 0 ifTrue:[^ self].
- cls := Smalltalk classNamed:className.
- cls isNil ifTrue:[
- "/ a new one
- (self confirm:'This is a new class. Add ?') ifFalse:[
- ^ self
- ].
- p
- addClass:className
- classFileName:((Smalltalk fileNameForClass:className) , '.st').
- ] ifFalse:[
- cls package ~= p package ifTrue:[
- "/ a new one
- (self confirm:'Change the classes package from ' , cls package , ' to ' , p package , ' ?') ifFalse:[
- ^ self
- ].
- cls package:p package.
- ].
- p
- addClass:cls name
- classFileName:(cls classFilename
- ? ((Smalltalk fileNameForClass:cls) , '.st')).
- ].
-
- self updateClassListForProject:p
-
-!
-
addClasses
- "ask fo, and add a single class"
+ "ask for, and add a single class"
|p className cls oldPackage|
@@ -4340,343 +4375,6 @@
!
-addClassesFromFilesInDirectory
- self addClassesFromFilesInDirectoryWithFilter:nil
-!
-
-addClassesFromFilesInDirectoryIfPresentInImage
- self addClassesFromFilesInDirectoryWithFilter:[:classOrName | classOrName isBehavior]
-
-!
-
-addClassesFromFilesInDirectoryWithFilter:aFilterBlockOrNil
- |project existingClasses prjDirectory anyChange numSTFilesFound|
-
- project := self currentProject.
-
- existingClasses := project classInfo.
- anyChange := false.
- numSTFilesFound := 0.
-
- prjDirectory := project directory asFilename.
- (prjDirectory exists and:[prjDirectory isDirectory]) ifFalse:[
- self warn:'Invalid project directory: ' , prjDirectory pathName.
- ^ self
- ].
-
- prjDirectory directoryContents do:[:fn |
- |f oldInfo cls|
-
- f := prjDirectory construct:fn.
- (f hasSuffix:'st') ifTrue:[
- numSTFilesFound := numSTFilesFound + 1.
-
- oldInfo := existingClasses
- detect:[:clsInfo |
- clsInfo classFileName = fn
- ]
- ifNone:nil.
- oldInfo isNil ifTrue:[
- "/ extract className from fileName ...
- cls := Smalltalk filenameAbbreviations keyAtValue:(f withoutSuffix baseName ).
- cls isNil ifTrue:[
- cls := f withoutSuffix baseName asSymbol.
- project defaultNameSpace notNil ifTrue:[
- cls := (project defaultNameSpace name , '::' , cls) asSymbol
- ]
- ].
- (aFilterBlockOrNil isNil
- or:[aFilterBlockOrNil value:cls]) ifTrue:[
- project addClass:cls classFileName:fn.
- anyChange := true.
-Transcript showCR:'added ' , fn , ' as class: ' , cls printString.
- ] ifFalse:[
-Transcript showCR:'skipped ' , fn , ' as class: ' , cls printString.
- ]
-
- ]
- ]
- ].
-
- anyChange ifTrue:[
- self updateClassListForProject:project
- ] ifFalse:[
- numSTFilesFound == 0 ifTrue:[
- self information:'No st-sourcefiles found in ' , prjDirectory pathName.
- ]
- ]
-!
-
-addClassesFromImage
- "add classes with this packageId found in the image"
-
- |project|
-
- project := self currentProject.
- Smalltalk allClassesDo:[:aClass |
- aClass isMeta ifFalse:[
- (aClass isNamespace not or:[aClass == Smalltalk]) ifTrue:[
- aClass package = project package ifTrue:[
- (project classInfoFor:aClass) isNil ifTrue:[
- project
- addClass:aClass name
- classFileName:(aClass classFilename
- ? ((Smalltalk fileNameForClass:aClass) , '.st')).
- ]
- ]
- ]
- ]
- ].
-
- self updateClassListForProject:project
-
-!
-
-browseClasses
- |ns p classes nBad uniqueClasses|
-
- p := self currentProject.
- classes := p classes
- collect:[:clsOrName |
- |cls realName|
-
- clsOrName isSymbol ifTrue:[
- realName := clsOrName.
- (realName includes:$:) ifTrue:[
- (realName startsWith:'Smalltalk::') ifTrue:[
- realName := (realName copyFrom:'Smalltalk::' size + 1) asSymbol
- ]
- ].
- cls := Smalltalk at:realName
- ] ifFalse:[
- cls := clsOrName
- ].
- cls
- ].
-
- "/ remove duplicates - but want to preserve order
- "/ thats why we do not use asIdentitySet asOrderedCollection
- uniqueClasses := OrderedCollection new.
- classes do:[:cls | (uniqueClasses includesIdentical:cls) ifFalse:[uniqueClasses add:cls]].
-
- nBad := classes inject:0 into:[:sum :el | el isNil ifTrue:[sum+1] ifFalse:[sum]].
- nBad ~~ 0 ifTrue:[
- classes := classes select:[:cls | cls notNil].
- self warn:('Oops - %1 classes could not be found.\\You should probably load them first.' bindWith:nBad) withCRs.
- ].
-
-
- SystemBrowser
- browseClasses:classes title:('Classes in ' , p name) sort:true.
-
-
-
-!
-
-buildAll
- |p|
-
- p := self currentProject.
- p isNil ifTrue:[
- self information:'No project selected'.
- ^ self
- ].
-
- self withCursor:Cursor wait do:[
- "/ prepare the building ...
-
- (p propertyAt:#deliverLoadAllFile) == true ifTrue:[
- p createLoadAllFile
- ].
-
- (p propertyAt:#deliverSources) == true ifTrue:[
- p createSourceFiles
- ].
-
- (p propertyAt:#deliverMakefiles) == true ifTrue:[
- self buildMakefiles
- ].
-
- (p propertyAt:#deliverCompiledBinary) == true ifTrue:[
- self buildCompiledClassLibrary
- ].
-
- (p propertyAt:#deliverByteCode) == true ifTrue:[
- self buildByteCodeClassLibrary
- ].
-
- "/ now, deploy ...
-
- (p propertyAt:#deliverZipArchive) == true ifTrue:[
- p buildZipArchive
- ].
-
- (p propertyAt:#deliverTarArchive) == true ifTrue:[
- p buildTarArchive
- ].
-
- (p propertyAt:#deliverGZipArchive) == true ifTrue:[
- p buildGZipArchive
- ].
- ].
-
-
-!
-
-buildCompiledClassLibrary
- "compile a binary class library in the projects directory"
- |p diagnosticFile diagnostic error textBox|
-
- p := self currentProject.
- p isNil ifTrue:[
- self information:'No project selected'.
- ^ self
- ].
-
- "/ check for directory ...
- (self checkForProjectDirectoryFor:p) ifFalse:[
- ^ self
- ].
-
- "/ check for Make.proto ...
- (self checkForMakeProtoFor:p) ifFalse:[
- ^ self
- ].
-
- "/ check for Makefile ...
- (self checkForMakefileFor:p) ifFalse:[
- ^ self
- ].
-
- "/ now, execute the makefile found there ...
- diagnosticFile := Filename newTemporary.
- diagnostic := diagnosticFile writeStream.
- error := false.
-
- [
- self withCursor:Cursor wait do:[
- OperatingSystem
- executeCommand:'make'
- inputFrom:nil
- outputTo:diagnostic
- errorTo:diagnostic
- inDirectory:(p directory asFilename pathName)
- onError:[error := true].
- ].
-
- diagnostic close.
-
- textBox := TextBox new.
- textBox initialText:(diagnosticFile readStream contents).
- textBox title:'Make Diagnostic output:'.
- textBox readOnly:true.
- textBox noCancel.
- textBox label:'Make Diagnostic output'.
- textBox extent:(600@250); sizeFixed:true.
- textBox showAtPointer.
-
- ] valueNowOrOnUnwindDo:[
- diagnosticFile delete
- ].
-
-
-!
-
-buildLoadAllFile
- |p |
-
- p := self currentProject.
- p isNil ifTrue:[
- self information:'No project selected'.
- ^ self
- ].
-
- self withCursor:Cursor wait do:[
- p createLoadAllFile.
- ]
-!
-
-buildMakefiles
- |p |
-
- p := self currentProject.
- p isNil ifTrue:[
- self information:'No project selected'.
- ^ self
- ].
-
- self withCursor:Cursor wait do:[
- p createProtoMakefile.
- p createMakefile
- ].
-!
-
-checkInProject
- |p classes methods anyMethodMissing|
-
- p := self currentProject.
- p isNil ifTrue:[
- self information:'No project selected'.
- ^ self
- ].
-
- "/ check in classes ...
-
- classes := p classes.
- classes do:[:aClass |
- |clsName|
-
- aClass isBehavior ifFalse:[
- aClass isSymbol ifTrue:[
- clsName := aClass
- ] ifFalse:[
- clsName := aClass className
- ].
- Transcript showCR:('ProjectBrowser: cannot checkIn unloaded class: ' , clsName).
- ] ifTrue:[
- aClass isLoaded ifFalse:[
- Transcript showCR:('ProjectBrowser: cannot checkIn unloaded class: ' , aClass name).
- ] ifTrue:[
- aClass owningClass isNil ifTrue:[ "/ skip private classes
- Transcript showCR:('ProjectBrowser: checking in class: ' , aClass name).
- self checkInClass:aClass.
- ]
- ]
- ]
- ].
-
- "/ check methods ...
-
- anyMethodMissing := false.
- methods := p methods.
- methods size > 0 ifTrue:[
- methods do:[:aMethod |
- aMethod isMethod ifFalse:[
- Transcript showCR:('ProjectBrowser: cannot checkIn unloaded method: ' , aMethod className , ' ' , aMethod methodName).
- anyMethodMissing := true.
- ]
- ].
- anyMethodMissing ifTrue:[
- Transcript showCR:'ProjectBrowser: cannot save method patches & extensions due to missing method(s)'.
- ] ifFalse:[
- Transcript showCR:('ProjectBrowser: checking in patches & extensions').
- self checkInMethods:methods
- ].
- ].
-
- "/ check in the project file itself
- self checkInProjectFile.
-
-!
-
-inspectCurrentProject
- "inspect the current project"
-
- self hasProjectSelected ifTrue:[
- self currentProject inspect.
- ]
-!
-
itemDoubleClicked:index
|node classOrClassName cls|
@@ -4730,15 +4428,6 @@
"Modified: / 26.4.1999 / 22:49:20 / cg"
!
-loadClassesFromDirectory
- "load all classes as contained in the project into the system"
-
- self withReadCursorDo:[
- self currentProject loadClassesFromProjectDirectory.
- ].
-
-!
-
loadFromProjectFile:aFilenameString
|oldNode newProject|
@@ -4862,87 +4551,10 @@
]
!
-makeCurrentProject
- "make the selected Project the current project"
-
- |project|
-
- self hasProjectSelected ifTrue:[
- project := self currentProject.
-
- Project current:project.
- self showWhat value == #current ifTrue:[
- self updateProjectTree
- ]
- ]
-!
-
methodPatchDoubleClick:arg
self halt.
!
-newProject
- self newProject:Project new.
-
-!
-
-newProject:newProject
- |newNode|
-
- newNode := self nodeFor:newProject.
- self addProjectNodeToTree:newNode.
- self projectTreeHolder root:projectTree.
-"/ self projectTreeHolder selectNode:newNode.
-"/ self projectTreeHolder expand:newNode.
-
- self readAspectsFromProject.
- newProject wasLoadedFromFile ifFalse:[
- self updateListOfRequiredPrerequisiteClasses.
- ]
-!
-
-newSubProject
- |projectNode subProjectsNode newNode parentProject newProject|
-
- projectNode := self currentProjectNode.
-
- projectNode notNil ifTrue:[
- parentProject := projectNode contents.
- subProjectsNode := projectNode children detect:[:child | child contents == #subprojects].
-self halt.
- parentProject notNil ifTrue:[
- newProject := Project new.
- newNode := self nodeFor:newProject.
-
- parentProject addSubProject:newProject.
- subProjectsNode add:newNode.
- self projectTreeHolder root:projectTree.
- self projectTreeHolder selectNode:newNode.
- ]
- ]
-
-!
-
-openDocumentation
- self openHTMLDocument: 'tools/pbrowser/TOP.html'
-
-!
-
-openProject
- |fn|
-
- fn := Dialog
- requestFileName:'filename:'
- default:nil
- ifFail:nil
- pattern:'*.prj'
- fromDirectory:(FileSelectionBox lastFileSelectionDirectory).
-
- fn notNil ifTrue:[
- self loadFromProjectFile:fn.
- ]
-!
-
projectFilterChanged
|theNode|
@@ -4960,68 +4572,6 @@
].
!
-removeProject
- |projectToRemove selectedNode subNode newNode parentNode parentProject newProject|
-
- self hasProjectNodeSelected ifTrue:[
- selectedNode := self selectedTreeNode.
- projectToRemove := selectedNode contents.
-
- (self confirm:'Really remove the project ?') ifTrue:[
- self withExecuteCursorDo:[
- self projectTreeHolder removeSelection.
- projectToRemove removeFromSystem.
- ]
- ]
- ]
-!
-
-renameProject
- |nm projectNode selectedProject|
-
- projectNode := self currentProjectNode.
- projectNode notNil ifTrue:[
- selectedProject := projectNode contents.
-
- nm := Dialog
- request:'Rename to:'
- initialAnswer:selectedProject name.
-
- nm size > 0 ifTrue:[
- selectedProject name:nm.
-"/ selectedNode name:nm.
-"/ selectedNode changed.
- ]
- ]
-!
-
-saveProjectFile
- |d p|
-
- self modifiedChannel value ifTrue:[
- (self confirm:'Changes not confirmed; save anyway ?') ifFalse:[^ self]
- ].
-
- p := self currentProject.
- p isNil ifTrue:[
- self information:'Select a project first.'.
- ^self
- ].
- p directory isNil ifTrue:[
- d := (Dialog request:'Project Directory:').
- d size == 0 ifTrue:[
- ^ self
- ].
- p directory:d
- ].
-
- self withCursor:Cursor write do:[
- p saveAsProjectFile.
- ]
-
- "Modified: / 26.4.1999 / 22:43:57 / cg"
-!
-
selectionChangeAllowed:newNode
|answer|
@@ -5260,55 +4810,6 @@
l addAll:methodInfo.
-!
-
-validateAgainstClassesInImage
- "validate classes in project against classes found in the image"
-
- |project classesInProjectOnly classesInImageOnly bindings|
-
- project := self currentProject.
- classesInImageOnly := IdentitySet new.
- classesInProjectOnly := IdentitySet new.
-
- Smalltalk allClassesDo:[:aClass |
- aClass isMeta ifFalse:[
- (aClass isNamespace not or:[aClass == Smalltalk]) ifTrue:[
- aClass package = project package ifTrue:[
- (project classInfoFor:aClass) isNil ifTrue:[
- classesInImageOnly add:aClass name.
- ]
- ]
- ]
- ]
- ].
- project classInfo do:[:clsInfo |
- |clsName cls|
-
- clsName := clsInfo className.
- cls := Smalltalk at:clsName asSymbol.
- (cls isBehavior not) ifTrue:[
- classesInProjectOnly add:clsName
- ].
- ].
-
- (classesInImageOnly isEmpty and:[classesInProjectOnly isEmpty]) ifTrue:[
- self information:'Set of classes in project and image are equal.'.
- ^ self.
- ].
-
- classesInImageOnly := classesInImageOnly asOrderedCollection sort.
- classesInProjectOnly := classesInProjectOnly asOrderedCollection sort.
-
- bindings := IdentityDictionary new.
- bindings at:#classesInImageOnly put:classesInImageOnly.
- bindings at:#classesInProjectOnly put:classesInProjectOnly.
-
- SimpleDialog
- openDialogInterfaceSpec:(self class classValidationDialogSpec)
- withBindings:bindings
-
- "Modified: / 26.9.1999 / 16:03:50 / cg"
! !
!ProjectBrowser methodsFor:'user actions - canvas'!
@@ -5506,6 +5007,680 @@
self valueOfInfoLabel value:nil
! !
+!ProjectBrowser methodsFor:'user actions - menu'!
+
+addClass
+ "ask for, and add a single class"
+
+ |p className cls|
+
+ p := self currentProject.
+
+ className := Dialog request:'Class to add:'.
+ className size == 0 ifTrue:[^ self].
+ cls := Smalltalk classNamed:className.
+ cls isNil ifTrue:[
+ "/ a new one
+ (self confirm:'This is a new class. Add ?') ifFalse:[
+ ^ self
+ ].
+ p
+ addClass:className
+ classFileName:((Smalltalk fileNameForClass:className) , '.st').
+ ] ifFalse:[
+ cls package ~= p package ifTrue:[
+ "/ a new one
+ (self confirm:'Change the classes package from ' , cls package , ' to ' , p package , ' ?') ifFalse:[
+ ^ self
+ ].
+ cls package:p package.
+ ].
+ p
+ addClass:cls name
+ classFileName:(cls classFilename
+ ? ((Smalltalk fileNameForClass:cls) , '.st')).
+ ].
+
+ self updateClassListForProject:p
+
+!
+
+addClassesFromFilesInDirectory
+ "add all classes found from files in the project directory"
+
+ self addClassesFromFilesInDirectoryWithFilter:nil
+!
+
+addClassesFromFilesInDirectoryIfPresentInImage
+ "add all classes found from files in the project directory,
+ but only if class is currently present in the image."
+
+ self addClassesFromFilesInDirectoryWithFilter:[:classOrName | classOrName isBehavior]
+
+!
+
+addClassesFromFilesInDirectoryWithFilter:aFilterBlockOrNil
+ "helper to add all classes found from files in the project directory"
+
+ |project existingClasses prjDirectory anyChange numSTFilesFound|
+
+ project := self currentProject.
+
+ existingClasses := project classInfo.
+ anyChange := false.
+ numSTFilesFound := 0.
+
+ prjDirectory := project directory asFilename.
+ (prjDirectory exists and:[prjDirectory isDirectory]) ifFalse:[
+ self warn:'Invalid project directory: ' , prjDirectory pathName.
+ ^ self
+ ].
+
+ prjDirectory directoryContents do:[:fn |
+ |f oldInfo cls|
+
+ f := prjDirectory construct:fn.
+ (f hasSuffix:'st') ifTrue:[
+ numSTFilesFound := numSTFilesFound + 1.
+
+ oldInfo := existingClasses
+ detect:[:clsInfo |
+ clsInfo classFileName = fn
+ ]
+ ifNone:nil.
+ oldInfo isNil ifTrue:[
+ "/ extract className from fileName ...
+ cls := Smalltalk filenameAbbreviations keyAtValue:(f withoutSuffix baseName ).
+ cls isNil ifTrue:[
+ cls := f withoutSuffix baseName asSymbol.
+ project defaultNameSpace notNil ifTrue:[
+ cls := (project defaultNameSpace name , '::' , cls) asSymbol
+ ]
+ ].
+ (aFilterBlockOrNil isNil
+ or:[aFilterBlockOrNil value:cls]) ifTrue:[
+ project addClass:cls classFileName:fn.
+ anyChange := true.
+Transcript showCR:'added ' , fn , ' as class: ' , cls printString.
+ ] ifFalse:[
+Transcript showCR:'skipped ' , fn , ' as class: ' , cls printString.
+ ]
+
+ ]
+ ]
+ ].
+
+ anyChange ifTrue:[
+ self updateClassListForProject:project
+ ] ifFalse:[
+ numSTFilesFound == 0 ifTrue:[
+ self information:'No st-sourcefiles found in ' , prjDirectory pathName.
+ ]
+ ]
+!
+
+addClassesFromImage
+ "add classes with this packageId found in the image"
+
+ |project|
+
+ project := self currentProject.
+ Smalltalk allClassesDo:[:aClass |
+ aClass isMeta ifFalse:[
+ (aClass isNamespace not or:[aClass == Smalltalk]) ifTrue:[
+ aClass package = project package ifTrue:[
+ (project classInfoFor:aClass) isNil ifTrue:[
+ project
+ addClass:aClass name
+ classFileName:(aClass classFilename
+ ? ((Smalltalk fileNameForClass:aClass) , '.st')).
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ self updateClassListForProject:project
+
+!
+
+browseClasses
+ "browse the projects classes"
+
+ |ns p classes nBad uniqueClasses|
+
+ p := self currentProject.
+ classes := p classes
+ collect:[:clsOrName |
+ |cls realName|
+
+ clsOrName isSymbol ifTrue:[
+ realName := clsOrName.
+ (realName includes:$:) ifTrue:[
+ (realName startsWith:'Smalltalk::') ifTrue:[
+ realName := (realName copyFrom:'Smalltalk::' size + 1) asSymbol
+ ]
+ ].
+ cls := Smalltalk at:realName
+ ] ifFalse:[
+ cls := clsOrName
+ ].
+ cls
+ ].
+
+ "/ remove duplicates - but want to preserve order
+ "/ thats why we do not use asIdentitySet asOrderedCollection
+ uniqueClasses := OrderedCollection new.
+ classes do:[:cls | (uniqueClasses includesIdentical:cls) ifFalse:[uniqueClasses add:cls]].
+
+ nBad := classes inject:0 into:[:sum :el | el isNil ifTrue:[sum+1] ifFalse:[sum]].
+ nBad ~~ 0 ifTrue:[
+ classes := classes select:[:cls | cls notNil].
+ self warn:('Oops - %1 classes could not be found.\\You should probably load them first.' bindWith:nBad) withCRs.
+ ].
+
+
+ SystemBrowser
+ browseClasses:classes title:('Classes in ' , p name) sort:true.
+
+
+
+!
+
+buildAll
+ "build all as specified in the deployment section"
+
+ |p|
+
+ p := self currentProject.
+ p isNil ifTrue:[
+ self information:'No project selected'.
+ ^ self
+ ].
+
+ self withCursor:Cursor wait do:[
+ "/ prepare the building ...
+
+ (p propertyAt:#deliverLoadAllFile) == true ifTrue:[
+ p createLoadAllFile
+ ].
+
+ (p propertyAt:#deliverSources) == true ifTrue:[
+ p createSourceFiles
+ ].
+
+ (p propertyAt:#deliverMakefiles) == true ifTrue:[
+ self buildMakefiles
+ ].
+
+ (p propertyAt:#deliverCompiledBinary) == true ifTrue:[
+ self buildCompiledClassLibrary
+ ].
+
+ (p propertyAt:#deliverByteCode) == true ifTrue:[
+ self buildByteCodeClassLibrary
+ ].
+
+ "/ now, deploy ...
+
+ (p propertyAt:#deliverZipArchive) == true ifTrue:[
+ p buildZipArchive
+ ].
+
+ (p propertyAt:#deliverTarArchive) == true ifTrue:[
+ p buildTarArchive
+ ].
+
+ (p propertyAt:#deliverGZipArchive) == true ifTrue:[
+ p buildGZipArchive
+ ].
+ ].
+
+
+!
+
+buildCompiledClassLibrary
+ "compile a binary class library in the projects directory"
+
+ |p diagnosticFile diagnostic error textBox|
+
+ p := self currentProject.
+ p isNil ifTrue:[
+ self information:'No project selected'.
+ ^ self
+ ].
+
+ "/ check for directory ...
+ (self checkForProjectDirectoryFor:p) ifFalse:[
+ ^ self
+ ].
+
+ "/ check for Make.proto ...
+ (self checkForMakeProtoFor:p) ifFalse:[
+ ^ self
+ ].
+
+ "/ check for Makefile ...
+ (self checkForMakefileFor:p) ifFalse:[
+ ^ self
+ ].
+
+ "/ now, execute the makefile found there ...
+ diagnosticFile := Filename newTemporary.
+ diagnostic := diagnosticFile writeStream.
+ error := false.
+
+ [
+ self withCursor:Cursor wait do:[
+ OperatingSystem
+ executeCommand:'make'
+ inputFrom:nil
+ outputTo:diagnostic
+ errorTo:diagnostic
+ inDirectory:(p directory asFilename pathName)
+ onError:[error := true].
+ ].
+
+ diagnostic close.
+
+ textBox := TextBox new.
+ textBox initialText:(diagnosticFile readStream contents).
+ textBox title:'Make Diagnostic output:'.
+ textBox readOnly:true.
+ textBox noCancel.
+ textBox label:'Make Diagnostic output'.
+ textBox extent:(600@250); sizeFixed:true.
+ textBox showAtPointer.
+
+ ] valueNowOrOnUnwindDo:[
+ diagnosticFile delete
+ ].
+
+
+!
+
+buildLoadAllFile
+ "generate a loadAll file in the projects directory"
+
+ |p |
+
+ p := self currentProject.
+ p isNil ifTrue:[
+ self information:'No project selected'.
+ ^ self
+ ].
+
+ self withCursor:Cursor wait do:[
+ p createLoadAllFile.
+ ]
+!
+
+buildMakefiles
+ "generate a Make.proto and Makefile in the projects directory"
+
+ |p |
+
+ p := self currentProject.
+ p isNil ifTrue:[
+ self information:'No project selected'.
+ ^ self
+ ].
+
+ self withCursor:Cursor wait do:[
+ p createProtoMakefile.
+ p createMakefile
+ ].
+!
+
+checkInAllClasses
+ "check in all classes"
+
+ |p classes methods anyMethodMissing|
+
+ p := self currentProject.
+ p isNil ifTrue:[
+ self information:'No project selected'.
+ ^ self
+ ].
+
+ "/ check in classes ...
+
+ classes := p classes.
+ classes do:[:aClass |
+ |clsName|
+
+ aClass isBehavior ifFalse:[
+ aClass isSymbol ifTrue:[
+ clsName := aClass
+ ] ifFalse:[
+ clsName := aClass className
+ ].
+ Transcript showCR:('ProjectBrowser: cannot checkIn unloaded class: ' , clsName).
+ ] ifTrue:[
+ aClass isLoaded ifFalse:[
+ Transcript showCR:('ProjectBrowser: cannot checkIn unloaded class: ' , aClass name).
+ ] ifTrue:[
+ aClass owningClass isNil ifTrue:[ "/ skip private classes
+ Transcript showCR:('ProjectBrowser: checking in class: ' , aClass name).
+ self checkInClass:aClass.
+ ]
+ ]
+ ]
+ ].
+
+
+!
+
+checkInMethods
+ "check in all extensions (patches)"
+
+ |p methods anyMethodMissing|
+
+ p := self currentProject.
+ p isNil ifTrue:[
+ self information:'No project selected'.
+ ^ self
+ ].
+
+ "/ check methods ...
+
+ anyMethodMissing := false.
+ methods := p methods.
+ methods size > 0 ifTrue:[
+ methods do:[:aMethod |
+ aMethod isMethod ifFalse:[
+ Transcript showCR:('ProjectBrowser: cannot checkIn unloaded method: ' , aMethod className , ' ' , aMethod methodName).
+ anyMethodMissing := true.
+ ]
+ ].
+ anyMethodMissing ifTrue:[
+ Transcript showCR:'ProjectBrowser: cannot save method patches & extensions due to missing method(s)'.
+ ] ifFalse:[
+ Transcript showCR:('ProjectBrowser: checking in patches & extensions').
+ self checkInMethods:methods
+ ].
+ ].
+
+!
+
+checkInProject
+ "check in all classes and extensions"
+
+ |p|
+
+ p := self currentProject.
+ p isNil ifTrue:[
+ self information:'No project selected'.
+ ^ self
+ ].
+
+ "/ check in classes ...
+ self checkInAllClasses.
+
+ "/ check methods ...
+ self checkInMethods.
+
+ "/ check in the project file itself
+ self checkInProjectFile.
+
+!
+
+inspectCurrentProject
+ "inspect the current project"
+
+ self hasProjectSelected ifTrue:[
+ self currentProject inspect.
+ ]
+!
+
+loadClassesFromDirectory
+ "load all classes as contained in the project into the system"
+
+ self withReadCursorDo:[
+ self currentProject loadClassesFromProjectDirectory.
+ ].
+
+!
+
+makeCurrentProject
+ "make the selected Project the current project"
+
+ |project|
+
+ self hasProjectSelected ifTrue:[
+ project := self currentProject.
+
+ Project current:project.
+ self showWhat value == #current ifTrue:[
+ self updateProjectTree
+ ]
+ ]
+!
+
+moveMethodToProject
+ |p mthd newPackage|
+
+ p := self currentProject.
+
+ mthd := self selectedMethod.
+ mthd notNil ifTrue:[
+ newPackage := Dialog request:'Move to project:'.
+ (newPackage size > 0 and:[newPackage ~= p package]) ifTrue:[
+ mthd package:newPackage asSymbol.
+ p removeMethod:mthd.
+ self updatePatchesListForProject:p.
+ self projectTree remove:self selectedTreeNode.
+ ]
+ ].
+!
+
+newProject
+ self newProject:Project new.
+
+!
+
+newProject:newProject
+ |newNode|
+
+ newNode := self nodeFor:newProject.
+ self addProjectNodeToTree:newNode.
+ self projectTreeHolder root:projectTree.
+"/ self projectTreeHolder selectNode:newNode.
+"/ self projectTreeHolder expand:newNode.
+
+ self readAspectsFromProject.
+ newProject wasLoadedFromFile ifFalse:[
+ self updateListOfRequiredPrerequisiteClasses.
+ ]
+!
+
+newSubProject
+ |projectNode subProjectsNode newNode parentProject newProject|
+
+ projectNode := self currentProjectNode.
+
+ projectNode notNil ifTrue:[
+ parentProject := projectNode contents.
+ subProjectsNode := projectNode children detect:[:child | child contents == #subprojects].
+self halt.
+ parentProject notNil ifTrue:[
+ newProject := Project new.
+ newNode := self nodeFor:newProject.
+
+ parentProject addSubProject:newProject.
+ subProjectsNode add:newNode.
+ self projectTreeHolder root:projectTree.
+ self projectTreeHolder selectNode:newNode.
+ ]
+ ]
+
+!
+
+openDocumentation
+ self openHTMLDocument: 'tools/pbrowser/TOP.html'
+
+!
+
+openProject
+ |fn|
+
+ fn := Dialog
+ requestFileName:'filename:'
+ default:nil
+ ifFail:nil
+ pattern:'*.prj'
+ fromDirectory:(FileSelectionBox lastFileSelectionDirectory).
+
+ fn notNil ifTrue:[
+ self loadFromProjectFile:fn.
+ ]
+!
+
+removeMethod
+ |p mthd|
+
+ p := self currentProject.
+
+ mthd := self selectedMethod.
+ mthd notNil ifTrue:[
+ (self confirm:'Really remove the method (from both project and image) ?') ifTrue:[
+ p removeMethod:mthd.
+ mthd who methodClass removeSelector:mthd who methodSelector.
+ self updatePatchesListForProject:p.
+ self projectTree remove:self selectedTreeNode.
+ ]
+ ].
+!
+
+removeMethodFromProject
+ |p mthd|
+
+ p := self currentProject.
+
+ mthd := self selectedMethod.
+ mthd notNil ifTrue:[
+ (self confirm:'Really remove the method (from the project) ?') ifTrue:[
+ mthd package:#unknown.
+ p removeMethod:mthd.
+ self updatePatchesListForProject:p.
+ self projectTree remove:self selectedTreeNode.
+ ]
+ ].
+!
+
+removeProject
+ |projectToRemove selectedNode subNode newNode parentNode parentProject newProject|
+
+ self hasProjectNodeSelected ifTrue:[
+ selectedNode := self selectedTreeNode.
+ projectToRemove := selectedNode contents.
+
+ (self confirm:'Really remove the project ?') ifTrue:[
+ self withExecuteCursorDo:[
+ self projectTreeHolder removeSelection.
+ projectToRemove removeFromSystem.
+ ]
+ ]
+ ]
+!
+
+renameProject
+ |nm projectNode selectedProject|
+
+ projectNode := self currentProjectNode.
+ projectNode notNil ifTrue:[
+ selectedProject := projectNode contents.
+
+ nm := Dialog
+ request:'Rename to:'
+ initialAnswer:selectedProject name.
+
+ nm size > 0 ifTrue:[
+ selectedProject name:nm.
+"/ selectedNode name:nm.
+"/ selectedNode changed.
+ ]
+ ]
+!
+
+saveProjectFile
+ "save the project file in the project directory"
+
+ |d p|
+
+ self modifiedChannel value ifTrue:[
+ (self confirm:'Changes not confirmed; save anyway ?') ifFalse:[^ self]
+ ].
+
+ p := self currentProject.
+ p isNil ifTrue:[
+ self information:'Select a project first.'.
+ ^self
+ ].
+ p directory isNil ifTrue:[
+ d := (Dialog request:'Project Directory:').
+ d size == 0 ifTrue:[
+ ^ self
+ ].
+ p directory:d
+ ].
+
+ self withCursor:Cursor write do:[
+ p saveAsProjectFile.
+ ]
+
+ "Modified: / 26.4.1999 / 22:43:57 / cg"
+!
+
+validateAgainstClassesInImage
+ "validate classes in project against classes found in the image"
+
+ |project classesInProjectOnly classesInImageOnly bindings|
+
+ project := self currentProject.
+ classesInImageOnly := IdentitySet new.
+ classesInProjectOnly := IdentitySet new.
+
+ Smalltalk allClassesDo:[:aClass |
+ aClass isMeta ifFalse:[
+ (aClass isNamespace not or:[aClass == Smalltalk]) ifTrue:[
+ aClass package = project package ifTrue:[
+ (project classInfoFor:aClass) isNil ifTrue:[
+ classesInImageOnly add:aClass name.
+ ]
+ ]
+ ]
+ ]
+ ].
+ project classInfo do:[:clsInfo |
+ |clsName cls|
+
+ clsName := clsInfo className.
+ cls := Smalltalk at:clsName asSymbol.
+ (cls isBehavior not) ifTrue:[
+ classesInProjectOnly add:clsName
+ ].
+ ].
+
+ (classesInImageOnly isEmpty and:[classesInProjectOnly isEmpty]) ifTrue:[
+ self information:'Set of classes in project and image are equal.'.
+ ^ self.
+ ].
+
+ classesInImageOnly := classesInImageOnly asOrderedCollection sort.
+ classesInProjectOnly := classesInProjectOnly asOrderedCollection sort.
+
+ bindings := IdentityDictionary new.
+ bindings at:#classesInImageOnly put:classesInImageOnly.
+ bindings at:#classesInProjectOnly put:classesInProjectOnly.
+
+ SimpleDialog
+ openDialogInterfaceSpec:(self class classValidationDialogSpec)
+ withBindings:bindings
+
+ "Modified: / 26.9.1999 / 16:03:50 / cg"
+! !
+
!ProjectBrowser::ProjectTreeItem methodsFor:'accessing'!
action