hg/stx-libtool2: comparison ProjectBrowser.st

equal deleted inserted replaced

-:6fb170b75302
+:fc64935b7ff9
 #(#WindowSpec
 #label: 'ProjectBrowser'
 #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
 )
 #component:
 #(#SpecCollection
 #name: 'ToolBar1'
 #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 32 0)
 #menu: #menu
 #textDefault: true
 )
-#(#VariableHorizontalPanelSpec
+#(#VariableVerticalPanelSpec
-#name: 'VariableHorizontalPanel1'
+#name: 'VariableVerticalPanel1'
-#layout: #(#LayoutFrame 0 0.0 40 0.0 0 1.0 -24 1.0)
+#layout: #(#LayoutFrame 0 0.0 32 0.0 0 1.0 -24 1.0)
-#handles:
+#level: 1
-#(#OrderedCollection
-#Any 0.379433
-1.0
-)
 #component:
 #(#SpecCollection
 #collection: #(
-#(#SelectionInTreeViewSpec
+#(#VariableHorizontalPanelSpec
-#name: 'TreeList1'
+#name: 'VariableHorizontalPanel1'
-#model: #selectedTreeNodeHolder
+#component:
-#menu: #itemMenuHolder
+#(#SpecCollection
-#performer: #itemMenuPerformer
+#collection: #(
-#hasHorizontalScrollBar: true
+#(#SelectionInTreeViewSpec
-#hasVerticalScrollBar: true
+#name: 'TreeList1'
-#miniScrollerHorizontal: true
+#model: #selectedTreeNodeHolder
-#showRoot: false
+#menu: #itemMenuHolder
-#showDirectoryIndicatorForRoot: false
+#performer: #itemMenuPerformer
-#showDirectoryIndicator: true
+#hasHorizontalScrollBar: true
-#valueChangeSelector: #itemSelected:
+#hasVerticalScrollBar: true
-#doubleClickSelector: #itemDoubleClicked:
+#miniScrollerHorizontal: true
-#hierarchicalList: #projectTreeHolder
+#showRoot: false
-#selectConditionSelector: #selectionChangeAllowed:
+#showDirectoryIndicatorForRoot: false
-#highlightMode: #label
+#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
+#(#ArbitraryComponentSpec
-#name: 'SubCanvas1'
+#name: 'ArbitraryComponent1'
-#hasHorizontalScrollBar: false
+#hasBorder: false
-#hasVerticalScrollBar: false
-#specHolder: #currentCanvasHolder
 )
 )
 )
+#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
 )
 )
 #label: 'CheckIn All'
 #translateLabel: true
 #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
 )
 )
 #(#MenuItem
 #label: 'Browse Full'
 #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
 )
 !
 "Created: / 23.3.1999 / 14:16:12 / cg"
 "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|
 self withCursor:Cursor execute do:[
 showWhat := self showWhat value.
 ^ pInfo methodSelector
 ! !
 !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|
 p := self currentProject.
 self updateClassListForProject:p
 !
-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|
 self hasClassNodeSelected ifTrue:[
 node := self selectedTreeNode.
 self hasProjectSelectedHolder value:self hasProjectSelected.
 modifiedChannel value:false.
 "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|
 project isLoaded:true.
 self readAspectsFromProject
 ]
 !
-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|
 self projectTreeHolder expand:theNode.
 theNode := theNode parent.
 ].
 ].
-!
-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|
 l := self patchesList.
 l removeAll.
 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'!
 accept
 ].
 ].
 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
 "return the value of the instance variable 'action' (automatically generated)"

changeset 1248	fc64935b7ff9
parent 1242	243b06d0e230
child 1251	379bd54db35b