--- a/ProjectView.st Wed Oct 15 13:16:36 1997 +0200
+++ b/ProjectView.st Wed Oct 15 13:17:30 1997 +0200
@@ -40,42 +40,42 @@
ProjectViews basically offer two functionalities:
- keep a group of windows in order to organize the desktop
- (I am not sure, if this is really a useful feature, now that we
- have modern windowManagers which have multiple desktops as well).
+ (I am not sure, if this is really a useful feature, now that we
+ have modern windowManagers which have multiple desktops as well).
- All views as created while a project is active are remembered
- and can be hidden/shown altogether.
- (this has nothing to do with windowGroups)
+ All views as created while a project is active are remembered
+ and can be hidden/shown altogether.
+ (this has nothing to do with windowGroups)
- Also, it is possible to close down all those windows (by destroying the project).
+ Also, it is possible to close down all those windows (by destroying the project).
- keep defaults for various system activities:
- - the fileOut directory (i.e. where the SystemBrowser creates fileOut sources)
+ - the fileOut directory (i.e. where the SystemBrowser creates fileOut sources)
- - keep the source module/package
- thats the default offered when classes are checkedIn the very first time
+ - keep the source module/package
+ thats the default offered when classes are checkedIn the very first time
- - keep a default package-identifier assigned when classes/methods are created/modified.
- thats mostly useful to browse all classes/methods that have been touched
- in a projects context
+ - keep a default package-identifier assigned when classes/methods are created/modified.
+ thats mostly useful to browse all classes/methods that have been touched
+ in a projects context
- - keep a per-project changeList
+ - keep a per-project changeList
- allow opening a browser on all classes/methods which were created or modified
- while a project was active.
+ while a project was active.
- allow opening a browser on this projects changeList (which contains the subset of changes
- which were done while this project was active)
+ which were done while this project was active)
- allow removal of all classes/methods which have the current projects packageIdentifier
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Project
- Namespace
- CVSSourceCodemanager
+ Project
+ Namespace
+ CVSSourceCodemanager
"
! !
@@ -136,62 +136,62 @@
|labels selectors m|
labels := #(
- 'class documentation'
- '-'
- 'show'
- 'hide'
- '-'
- 'changes'
- 'browse'
- 'browse redefined'
- 'fileOut classes'
- '-'
- 'fileOut directory ...'
- 'repository defaults ...'
- 'package name ...'
- 'default nameSpace ...'
+ 'class documentation'
+ '-'
+ 'show'
+ 'hide'
+ '-'
+ 'changes'
+ 'browse'
+ 'browse redefined'
+ 'fileOut classes'
+ '-'
+ 'fileOut directory ...'
+ 'repository defaults ...'
+ 'package name ...'
+ 'default nameSpace for fileIn ...'
"/ '-'
"/ 'save project code'
"/ 'build'
- '-'
- 'remove package code'
- 'remove project'
- '-'
- 'rename ...'
- ).
+ '-'
+ 'remove package code'
+ 'remove project'
+ '-'
+ 'rename ...'
+ ).
selectors := #(
- showClassDocumentation
- nil
- showProject
- hideProject
- nil
- browseChanges
- browsePackage
- browseRedefined
- fileOutClasses
- nil
- projectDirectory
- projectRepositoryAndModule
- projectPackage
- projectNameSpace
+ showClassDocumentation
+ nil
+ showProject
+ hideProject
+ nil
+ browseChanges
+ browsePackage
+ browseRedefined
+ fileOutClasses
+ nil
+ projectDirectory
+ projectRepositoryAndModule
+ projectPackage
+ projectNameSpace
"/ nil
"/ saveProjectFiles
"/ buildProject
- nil
- removePackage
- destroy
- nil
- renameProject
- ).
+ nil
+ removePackage
+ destroy
+ nil
+ renameProject
+ ).
m := PopUpMenu
- labels:(resources array:labels)
- selectors:selectors
- receiver:self.
+ labels:(resources array:labels)
+ selectors:selectors
+ receiver:self.
SourceCodeManager isNil ifTrue:[
- m disableAll:#(#projectRepository #projectPackage).
+ m disableAll:#(#projectRepository #projectPackage).
].
^ m
@@ -210,8 +210,8 @@
changes := myProject changeSet.
changes size == 0 ifTrue:[
- self warn:(resources string:'no changes made in this project (yet)').
- ^ self
+ self warn:(resources string:'no changes made in this project (yet)').
+ ^ self
].
b := ChangeSetBrowser openOn:(myProject changeSet).
@@ -225,29 +225,29 @@
(i.e. whose packageIdentifier is the same as my Projects packageIdentifier)"
self topView withWaitCursorDo:[
- |classes packageName methods methodList anyClasses anyMethods ignoredClasses|
+ |classes packageName methods methodList anyClasses anyMethods ignoredClasses|
- anyMethods := anyClasses := false.
+ anyMethods := anyClasses := false.
- packageName := myProject packageName.
- classes := myProject classes.
- (classes notNil and:[classes notEmpty]) ifTrue:[
- anyClasses := true.
- ].
+ packageName := myProject packageName.
+ classes := myProject classes.
+ (classes notNil and:[classes notEmpty]) ifTrue:[
+ anyClasses := true.
+ ].
- methods := myProject individualMethods.
- methods notEmpty ifTrue:[
- anyMethods := true.
- SystemBrowser browseMethods:methods
- title:(resources string:'individual methods in package %1' with:packageName).
- ].
- anyClasses ifTrue:[
- SystemBrowser browseClasses:classes
- title:(resources string:'classes in package %1' with:packageName).
- ].
- (anyClasses or:[anyMethods]) ifFalse:[
- self information:(resources string:'no classes or methods in this project (yet)')
- ]
+ methods := myProject individualMethods.
+ methods notEmpty ifTrue:[
+ anyMethods := true.
+ SystemBrowser browseMethods:methods
+ title:(resources string:'individual methods in package %1' with:packageName).
+ ].
+ anyClasses ifTrue:[
+ SystemBrowser browseClasses:classes
+ title:(resources string:'classes in package %1' with:packageName).
+ ].
+ (anyClasses or:[anyMethods]) ifFalse:[
+ self information:(resources string:'no classes or methods in this project (yet)')
+ ]
]
"Created: 10.12.1995 / 00:08:58 / cg"
@@ -269,18 +269,18 @@
Thats methods which existed before and were redefined by package methods"
self topView withWaitCursorDo:[
- |redefined methods|
+ |redefined methods|
- redefined := myProject overwrittenMethods.
- redefined notNil ifTrue:[
- methods := redefined values.
- ].
- methods size > 0 ifTrue:[
- SystemBrowser browseMethods:methods
- title:(resources string:'redefined methods in package %1' with:myProject packageName).
- ] ifFalse:[
- self information:(resources string:'no redefined methods in this project (yet)')
- ]
+ redefined := myProject overwrittenMethods.
+ redefined notNil ifTrue:[
+ methods := redefined values.
+ ].
+ methods size > 0 ifTrue:[
+ SystemBrowser browseMethods:methods
+ title:(resources string:'redefined methods in package %1' with:myProject packageName).
+ ] ifFalse:[
+ self information:(resources string:'no redefined methods in this project (yet)')
+ ]
]
"Created: 27.1.1997 / 11:57:03 / cg"
@@ -293,12 +293,12 @@
build what is to be built: either a classLibrary or an application"
self topView withWaitCursorDo:[
- |dir|
+ |dir|
- self saveProjectFiles.
- (self confirm:'make object files in: ' , dir , ' ?') ifTrue:[
- myProject buildProject.
- ]
+ self saveProjectFiles.
+ (self confirm:'make object files in: ' , dir , ' ?') ifTrue:[
+ myProject buildProject.
+ ]
].
"Modified: 14.2.1997 / 13:38:06 / cg"
@@ -311,12 +311,12 @@
(myProject views notNil
and:[myProject views notEmpty]) ifTrue:[
- |box|
+ |box|
- box := YesNoBox new.
- box title:(resources string:'PROJECT_DESTROY') withCRs.
- box okText:(resources string:'yes').
- (box confirm) ifFalse:[^ self]
+ box := YesNoBox new.
+ box title:(resources string:'PROJECT_DESTROY') withCRs.
+ box okText:(resources string:'yes').
+ (box confirm) ifFalse:[^ self]
].
self doDestroy
@@ -342,30 +342,30 @@
CAVEAT: individual methods are not yet supported."
self topView withWaitCursorDo:[
- |classes packageName methods methodList anyClasses anyMethods ignoredClasses|
+ |classes packageName methods methodList anyClasses anyMethods ignoredClasses|
- anyMethods := anyClasses := false.
+ anyMethods := anyClasses := false.
- packageName := myProject packageName.
- classes := myProject classes.
- (classes notNil and:[classes notEmpty]) ifTrue:[
- anyClasses := true.
- ].
+ packageName := myProject packageName.
+ classes := myProject classes.
+ (classes notNil and:[classes notEmpty]) ifTrue:[
+ anyClasses := true.
+ ].
- methods := myProject individualMethods.
- methods notEmpty ifTrue:[
- anyMethods := true.
- self warn:'individual methods are currently not handled'
- ].
- anyClasses ifTrue:[
- classes do:[:aClass |
- Transcript showCR:'fileOut: ' , aClass name , ' ...'.
- aClass fileOut
- ].
- ].
- (anyClasses or:[anyMethods]) ifFalse:[
- self information:(resources string:'no classes or methods in this project (yet)')
- ]
+ methods := myProject individualMethods.
+ methods notEmpty ifTrue:[
+ anyMethods := true.
+ self warn:'individual methods are currently not handled'
+ ].
+ anyClasses ifTrue:[
+ classes do:[:aClass |
+ Transcript showCR:'fileOut: ' , aClass name , ' ...'.
+ aClass fileOut
+ ].
+ ].
+ (anyClasses or:[anyMethods]) ifFalse:[
+ self information:(resources string:'no classes or methods in this project (yet)')
+ ]
]
"Created: 11.4.1996 / 19:29:50 / cg"
@@ -394,24 +394,24 @@
box directoriesOnly.
box title:(resources string:'PROJECT_DIRECTPORY') withCRs.
(d := myProject directory) notNil ifTrue:[
- box initialText:d
+ box initialText:d
].
box action:[:dirName |
- (OperatingSystem isDirectory:dirName) ifFalse:[
- (OperatingSystem isValidPath:dirName) ifTrue:[
- self warn:(resources string:'%1 is not a valid directory' with:dirName).
- ^ self
- ].
- (self confirm:(resources string:'%1 does not exist\\create ?' with:dirName) withCRs) ifTrue:[
- (OperatingSystem recursiveCreateDirectory:dirName) ifFalse:[
- self warn:(resources string:'cannot create %1' with:dirName)
- ]
- ].
- ].
- "did it work ?"
- (OperatingSystem isDirectory:dirName) ifTrue:[
- myProject directory:dirName
- ].
+ (OperatingSystem isDirectory:dirName) ifFalse:[
+ (OperatingSystem isValidPath:dirName) ifTrue:[
+ self warn:(resources string:'%1 is not a valid directory' with:dirName).
+ ^ self
+ ].
+ (self confirm:(resources string:'%1 does not exist\\create ?' with:dirName) withCRs) ifTrue:[
+ (OperatingSystem recursiveCreateDirectory:dirName) ifFalse:[
+ self warn:(resources string:'cannot create %1' with:dirName)
+ ]
+ ].
+ ].
+ "did it work ?"
+ (OperatingSystem isDirectory:dirName) ifTrue:[
+ myProject directory:dirName
+ ].
].
box showAtPointer
@@ -425,25 +425,25 @@
classes do not conflict with existing ones ..."
self topView withWaitCursorDo:[
- |box allNameSpaces|
+ |box allNameSpaces|
- allNameSpaces := Namespace allNamespaces collect:[:ns | ns name].
+ allNameSpaces := Namespace allNamespaces collect:[:ns | ns name].
- box := ListSelectionBox title:(resources string:'default nameSpace:') withCRs.
- box list:(allNameSpaces asOrderedCollection sort).
- box action:[:nsName |
- |ns|
+ box := ListSelectionBox title:(resources string:'default nameSpace:') withCRs.
+ box list:(allNameSpaces asOrderedCollection sort).
+ box action:[:nsName |
+ |ns|
- "/ only create topLevel nameSpaces here
+ "/ only create topLevel nameSpaces here
- Class nameSpaceQuerySignal
- answer:Smalltalk
- do:[
- ns := Namespace name:nsName.
- ].
- myProject defaultNameSpace:ns
- ].
- box showAtPointer
+ Class nameSpaceQuerySignal
+ answer:Smalltalk
+ do:[
+ ns := Namespace name:nsName.
+ ].
+ myProject defaultNameSpace:ns
+ ].
+ box showAtPointer
]
"Created: 9.12.1995 / 16:50:45 / cg"
@@ -456,64 +456,64 @@
quickly later."
self topView withWaitCursorDo:[
- |box p existingPackages allClasses|
+ |box p existingPackages allClasses|
- existingPackages := Set new.
- (allClasses := Smalltalk allClasses) do:[:aClass |
- |p|
+ existingPackages := Set new.
+ (allClasses := Smalltalk allClasses) do:[:aClass |
+ |p|
- aClass isLoaded ifTrue:[
- (p := aClass package) notNil ifTrue:[
- existingPackages add:(p asString)
- ].
- aClass methodDictionary do:[:aMethod |
- (p := aMethod package) notNil ifTrue:[
- existingPackages add:(p asString)
- ]
- ].
- aClass class methodDictionary do:[:aMethod |
- (p := aMethod package) notNil ifTrue:[
- existingPackages add:(p asString)
- ]
- ].
- ]
- ].
+ aClass isLoaded ifTrue:[
+ (p := aClass package) notNil ifTrue:[
+ existingPackages add:(p asString)
+ ].
+ aClass methodDictionary do:[:aMethod |
+ (p := aMethod package) notNil ifTrue:[
+ existingPackages add:(p asString)
+ ]
+ ].
+ aClass class methodDictionary do:[:aMethod |
+ (p := aMethod package) notNil ifTrue:[
+ existingPackages add:(p asString)
+ ]
+ ].
+ ]
+ ].
- box := ListSelectionBox title:(resources string:'PROJECT_PACKAGENAME') withCRs.
- box list:(existingPackages asOrderedCollection sort).
- (p := myProject packageName) notNil ifTrue:[
- box initialText:p
- ].
- box action:[:packageName |
- |someClass module directory|
+ box := ListSelectionBox title:(resources string:'PROJECT_PACKAGENAME') withCRs.
+ box list:(existingPackages asOrderedCollection sort).
+ (p := myProject packageName) notNil ifTrue:[
+ box initialText:p
+ ].
+ box action:[:packageName |
+ |someClass module directory|
- "/ (try) to extract the module & repository directory from someClass which
- "/ is already contained in that package
+ "/ (try) to extract the module & repository directory from someClass which
+ "/ is already contained in that package
- Smalltalk allClasses
- detect:[:cls |
- |info|
+ Smalltalk allClasses
+ detect:[:cls |
+ |info|
- (cls package = packageName) ifTrue:[
- (info := cls packageSourceCodeInfo) notNil ifTrue:[
- module := info at:#module ifAbsent:nil.
- directory := info at:#directory ifAbsent:nil.
- ]
- ].
- module notNil and:[directory notNil].
- ]
- ifNone:nil.
+ (cls package = packageName) ifTrue:[
+ (info := cls packageSourceCodeInfo) notNil ifTrue:[
+ module := info at:#module ifAbsent:nil.
+ directory := info at:#directory ifAbsent:nil.
+ ]
+ ].
+ module notNil and:[directory notNil].
+ ]
+ ifNone:nil.
- module notNil ifTrue:[
- myProject repositoryModule:module
- ].
- directory notNil ifTrue:[
- myProject repositoryDirectory:directory
- ].
- myProject packageName:packageName.
+ module notNil ifTrue:[
+ myProject repositoryModule:module
+ ].
+ directory notNil ifTrue:[
+ myProject repositoryDirectory:directory
+ ].
+ myProject packageName:packageName.
- ].
- box showAtPointer
+ ].
+ box showAtPointer
]
"Created: 9.12.1995 / 16:50:45 / cg"
@@ -529,14 +529,14 @@
box := DialogBox new.
(box addTextLabel:(resources string:'PROJECT_MODULEANDDIR') withCRs)
- adjust:#left.
+ adjust:#left.
box addHorizontalLine.
moduleHolder := myProject repositoryModule asValue.
dirHolder := myProject repositoryDirectory asValue.
(box addTextLabel:(resources string:'PROJECT_MODULEDIR') withCRs)
- adjust:#left.
+ adjust:#left.
box addFilenameInputFieldOn:moduleHolder in:nil tabable:true.
box addVerticalSpace.
@@ -544,15 +544,15 @@
box addVerticalSpace.
(box addTextLabel:(resources string:'PROJECT_PACKAGEDIR') withCRs)
- adjust:#left.
+ adjust:#left.
box addFilenameInputFieldOn:dirHolder in:nil tabable:true.
box addAbortButton; addOkButton.
box showAtPointer.
box accepted ifTrue:[
- myProject repositoryModule:moduleHolder value.
- myProject repositoryDirectory:dirHolder value.
+ myProject repositoryModule:moduleHolder value.
+ myProject repositoryDirectory:dirHolder value.
].
box destroy.
@@ -571,69 +571,69 @@
(myProject isNil
or:[(theProject := myProject packageName) isNil]) ifTrue:[
- self warn:(resources string:'No current package.').
- ^ self
+ self warn:(resources string:'No current package.').
+ ^ self
].
classesToRemove := IdentitySet new.
methodsToRemove := IdentitySet new.
Smalltalk allClassesDo:[:aClass |
- |p|
+ |p|
- (p := aClass package) notNil ifTrue:[
- p = theProject ifTrue:[
- classesToRemove add:aClass
- ]
- ].
+ (p := aClass package) notNil ifTrue:[
+ p = theProject ifTrue:[
+ classesToRemove add:aClass
+ ]
+ ].
].
Smalltalk allClassesDo:[:aClass |
- |p|
+ |p|
- (classesToRemove includes:aClass) ifFalse:[
- aClass methodDictionary keysAndValuesDo:[:sel :aMethod |
- (p := aMethod package) notNil ifTrue:[
- p = theProject ifTrue:[
- methodsToRemove add:aMethod
- ]
- ]
- ].
- aClass class methodDictionary keysAndValuesDo:[:sel :aMethod |
- (p := aMethod package) notNil ifTrue:[
- p = theProject ifTrue:[
- methodsToRemove add:aMethod
- ]
- ]
- ].
- ].
+ (classesToRemove includes:aClass) ifFalse:[
+ aClass methodDictionary keysAndValuesDo:[:sel :aMethod |
+ (p := aMethod package) notNil ifTrue:[
+ p = theProject ifTrue:[
+ methodsToRemove add:aMethod
+ ]
+ ]
+ ].
+ aClass class methodDictionary keysAndValuesDo:[:sel :aMethod |
+ (p := aMethod package) notNil ifTrue:[
+ p = theProject ifTrue:[
+ methodsToRemove add:aMethod
+ ]
+ ]
+ ].
+ ].
].
(classesToRemove isEmpty
and:[methodsToRemove isEmpty]) ifTrue:[
- self warn:(resources string:'No classes or methods found in %1' with:theProject).
- ^ self
+ self warn:(resources string:'No classes or methods found in %1' with:theProject).
+ ^ self
].
(self confirm:(resources
- string:'About to remove %1 classes and %2 additional methods.\\Are you certain you want this ?'
- with:classesToRemove size
- with:methodsToRemove size) withCRs)
- ifTrue:[
- classesToRemove do:[:aClass |
- ('PROJECT: removing ' , aClass name) infoPrintNL.
- Smalltalk removeClass:aClass.
- ].
- methodsToRemove do:[:aMethod |
- |where|
+ string:'About to remove %1 classes and %2 additional methods.\\Are you certain you want this ?'
+ with:classesToRemove size
+ with:methodsToRemove size) withCRs)
+ ifTrue:[
+ classesToRemove do:[:aClass |
+ ('PROJECT: removing ' , aClass name) infoPrintNL.
+ Smalltalk removeClass:aClass.
+ ].
+ methodsToRemove do:[:aMethod |
+ |where|
- ('PROJECT: removing ' , aMethod displayString) infoPrintNL.
- where := aMethod who.
- where isNil ifTrue:[
- 'PROJECT: oops, some method is gone' infoPrintNL.
- ] ifFalse:[
- (where at:1) removeSelector:(where at:2)
- ]
- ]
+ ('PROJECT: removing ' , aMethod displayString) infoPrintNL.
+ where := aMethod who.
+ where isNil ifTrue:[
+ 'PROJECT: oops, some method is gone' infoPrintNL.
+ ] ifFalse:[
+ (where at:1) removeSelector:(where at:2)
+ ]
+ ]
].
!
@@ -648,9 +648,9 @@
box okText:(resources string:'rename').
box initialText:(myProject name).
box action:[:newName |
- myProject name:newName.
- self setProject:myProject.
- self windowGroup process name:'Project: ' , newName.
+ myProject name:newName.
+ self setProject:myProject.
+ self windowGroup process name:'Project: ' , newName.
].
box showAtPointer
@@ -662,12 +662,12 @@
This is not yet finished."
self topView withWaitCursorDo:[
- |dir|
+ |dir|
- dir := myProject directory.
- (self confirm:'create source files in: ' , dir , ' ?') ifTrue:[
- myProject createProjectFiles.
- ]
+ dir := myProject directory.
+ (self confirm:'create source files in: ' , dir , ' ?') ifTrue:[
+ myProject createProjectFiles.
+ ]
].
"Modified: 14.2.1997 / 13:40:40 / cg"
@@ -677,35 +677,35 @@
"open a documentViewer on the projects classes documentation only"
self topView withWaitCursorDo:[
- |classes packageName methods methodList anyClasses anyMethods
- html|
+ |classes packageName methods methodList anyClasses anyMethods
+ html|
- anyMethods := anyClasses := false.
+ anyMethods := anyClasses := false.
- packageName := myProject packageName.
- classes := myProject classes.
- (classes notNil and:[classes notEmpty]) ifTrue:[
- anyClasses := true.
- ].
- (anyClasses or:[anyMethods]) ifFalse:[
- self information:(resources string:'no classes or methods in this project (yet)').
- ^ self.
- ].
+ packageName := myProject packageName.
+ classes := myProject classes.
+ (classes notNil and:[classes notEmpty]) ifTrue:[
+ anyClasses := true.
+ ].
+ (anyClasses or:[anyMethods]) ifFalse:[
+ self information:(resources string:'no classes or methods in this project (yet)').
+ ^ self.
+ ].
- methods := myProject individualMethods.
- methods notEmpty ifTrue:[
- anyMethods := true.
- "/ not yet shown ...
- ].
+ methods := myProject individualMethods.
+ methods notEmpty ifTrue:[
+ anyMethods := true.
+ "/ not yet shown ...
+ ].
- anyClasses ifFalse:[ ^ self].
+ anyClasses ifFalse:[ ^ self].
- html := HTMLDocGenerator
- htmlClasses:classes
- title:'project classes'
- backTo:#none.
+ html := HTMLDocGenerator
+ htmlClasses:classes
+ title:'project classes'
+ backTo:#none.
- HTMLDocumentView openFullOnText:html
+ HTMLDocumentView openFullOnText:html
]
"Created: 11.4.1996 / 19:29:50 / cg"
@@ -717,7 +717,7 @@
the active projects views (except for those opened before)"
ActiveProjectView notNil ifTrue:[
- ActiveProjectView hideProject
+ ActiveProjectView hideProject
].
ActiveProjectView := self.
@@ -741,20 +741,20 @@
myProject := aProject.
e := (toggle width @ toggle height).
drawableId isNil ifTrue:[
- self minExtent:e.
- self maxExtent:e.
- self open
+ self minExtent:e.
+ self maxExtent:e.
+ self open
] ifFalse:[
- self unmap.
- self minExtent:e.
- self maxExtent:e.
- self extent:e.
- self remap
+ self unmap.
+ self minExtent:e.
+ self maxExtent:e.
+ self extent:e.
+ self remap
]
! !
!ProjectView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/ProjectView.st,v 1.39 1997-09-20 22:42:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ProjectView.st,v 1.40 1997-10-15 11:17:30 cg Exp $'
! !