--- a/ProjectBrowser.st Mon Apr 12 13:20:54 1999 +0200
+++ b/ProjectBrowser.st Fri Apr 16 21:01:01 1999 +0200
@@ -957,7 +957,7 @@
#valueChangeSelector: #itemSelected:
#doubleClickSelector: #itemDoubleClicked:
#hierarchicalList: #projectTreeHolder
- #selectConditionSelector: #selectionChangeAllowed
+ #selectConditionSelector: #selectionChangeAllowed:
#highlightMode: #label
)
#(#SubCanvasSpec
@@ -1048,16 +1048,28 @@
#enabled: #hasClassesSelectedHolder
)
#(#MenuItem
+ #label: 'Add Classes from files found in directory'
+ #translateLabel: true
+ #value: #addClassesFromFilesInDirectory
+ #enabled: #hasClassesSelectedHolder
+ )
+ #(#MenuItem
+ #label: 'Add Classes from files found in directory if present in image'
+ #translateLabel: true
+ #value: #addClassesFromFilesInDirectoryIfPresentInImage
+ #enabled: #hasClassesSelectedHolder
+ )
+ #(#MenuItem
#label: '-'
)
#(#MenuItem
- #label: 'Load Classes from Directory...'
+ #label: 'Load Classes from Directory'
#translateLabel: true
#value: #loadClassesFromDirectory
#enabled: #canLoadClassesFromDirectory
)
#(#MenuItem
- #label: 'Load Classes from Repository...'
+ #label: 'Load Classes from Repository'
#translateLabel: true
#value: #loadClassesFromRepository
#enabled: #canLoadClassesFromRepository
@@ -2251,6 +2263,60 @@
!
+addClassesFromFilesInDirectory
+ self addClassesFromFilesInDirectoryWithFilter:nil
+!
+
+addClassesFromFilesInDirectoryIfPresentInImage
+ self addClassesFromFilesInDirectoryWithFilter:[:classOrName | classOrName isBehavior]
+
+!
+
+addClassesFromFilesInDirectoryWithFilter:aFilterBlockOrNil
+ |project existingClasses prjDirectory anyChange|
+
+ project := self currentProject.
+
+ existingClasses := project classInfo.
+ anyChange := false.
+
+ prjDirectory := project directory asFilename.
+ prjDirectory directoryContents do:[:fn |
+ |f oldInfo cls|
+
+ f := prjDirectory construct:fn.
+ (f hasSuffix:'st') ifTrue:[
+ 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
+ ]
+ ].
+ (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
+ ]
+!
+
addToPrerequisites
|sel|
@@ -2278,7 +2344,7 @@
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.' bindWith:nBad).
+ self warn:('Oops - %1 classes could not be found.\\You should probably load the first.' bindWith:nBad) withCRs.
].
@@ -2289,6 +2355,23 @@
!
+buildAll
+ |p deliverLoadAllFile|
+
+ p := self currentProject.
+ p isNil ifTrue:[
+ self information:'No project selected'.
+ ^ self
+ ].
+
+ deliverLoadAllFile := p propertyAt:#deliverLoadAllFile.
+
+ deliverLoadAllFile ifTrue:[
+ p createLoadAllFile
+ ].
+
+!
+
cancel
"reload aspects from the project"
@@ -2472,9 +2555,12 @@
p saveAsProjectFile.
!
-selectionChangeAllowed
+selectionChangeAllowed:newNode
|answer|
+ newNode == self selectedTreeNode ifTrue:[
+ ^ true
+ ].
modifiedChannel value ifTrue:[
answer := Dialog confirmWithCancel:'Accept changes ?'.
answer isNil ifTrue:[
@@ -2508,17 +2594,12 @@
!
showClassListOf:anItem
- |projectItem project classInfo l|
+ |projectItem project|
projectItem := anItem parent.
project := projectItem contents.
- classInfo := project classInfo copy asOrderedCollection.
- classInfo sort:[:a :b | a className < b className].
-
- l := self classList.
- l removeAll.
- l addAll:classInfo.
+ self updateClassListForProject:project.
self currentCanvasHolder value:(self class rightCanvasSpecForClassList).
!
@@ -2583,6 +2664,18 @@
self currentCanvasHolder value:(self class rightCanvasSpecForReadOnlyText).
self rightCanvasTextHolder value:someText.
+!
+
+updateClassListForProject:aProject
+ |classInfo l|
+
+ classInfo := aProject classInfo copy asOrderedCollection.
+ classInfo sort:[:a :b | a className < b className].
+
+ l := self classList.
+ l removeAll.
+ l addAll:classInfo.
+
! !
!ProjectBrowser::ProjectTreeItem methodsFor:'accessing'!