--- a/BrowserView.st Tue Dec 12 18:37:13 1995 +0100
+++ b/BrowserView.st Tue Dec 12 23:11:41 1995 +0100
@@ -11,16 +11,16 @@
"
StandardSystemView subclass:#BrowserView
- instanceVariableNames:'classCategoryListView classListView methodCategoryListView
+ instanceVariableNames:'classCategoryListView classListView methodCategoryListView
methodListView classMethodListView codeView classToggle
instanceToggle currentClassCategory currentClassHierarchy
currentClass currentMethodCategory currentMethod currentSelector
showInstance actualClass fullClass lastMethodCategory aspect
variableListView fullProtocol lockUpdates autoSearch myLabel
acceptClass lastSourceLogMessage'
- classVariableNames:'CheckForInstancesWhenRemovingClasses RememberAspect DefaultIcon'
- poolDictionaries:''
- category:'Interface-Browsers'
+ classVariableNames:'CheckForInstancesWhenRemovingClasses RememberAspect DefaultIcon'
+ poolDictionaries:''
+ category:'Interface-Browsers'
!
!BrowserView class methodsFor:'documentation'!
@@ -1099,165 +1099,169 @@
(device ctrlDown
and:[currentClass notNil]) ifTrue:[
- labels := #(
- 'inspect class'
- '-'
- 'primitive definitions'
- 'primitive variables'
- 'primitive functions'
- ).
- selectors := #(
- classInspect
- nil
- classPrimitiveDefinitions
- classPrimitiveVariables
- classPrimitiveFunctions
- ).
-
- labels := labels , #(
- '-'
- 'revision info'
- 'compare with repository'
- '-'
- 'check into source repository'
- 'fileIn from repository'
- ).
-
- selectors := selectors , #(
- nil
- classRevisionInfo
- classCompareWithNewestInRepository
- nil
- classCheckin
- classLoadRevision
- ).
+ labels := #(
+ 'inspect class'
+ '-'
+ 'primitive definitions'
+ 'primitive variables'
+ 'primitive functions'
+ ).
+ selectors := #(
+ classInspect
+ nil
+ classPrimitiveDefinitions
+ classPrimitiveVariables
+ classPrimitiveFunctions
+ ).
+
+ labels := labels , #(
+ '-'
+ 'container'
+ '-'
+ 'revision info'
+ 'compare with repository'
+ '-'
+ 'check into source repository'
+ 'fileIn from repository'
+ ).
+
+ selectors := selectors , #(
+ nil
+ classModifyContainer
+ nil
+ classRevisionInfo
+ classCompareWithNewestInRepository
+ nil
+ classCheckin
+ classLoadRevision
+ ).
] ifFalse:[
- currentClass isNil ifTrue:[
- labels := #(
- 'new class'
- ).
- selectors := #(
- classNewClass
- ).
- ] ifFalse:[
- currentClass isLoaded ifFalse:[
- labels := #(
- 'definition'
- '-'
- 'new class'
- '-'
- 'load '
- ).
- selectors := #(
- classDefinition
- nil
- classNewClass
- nil
- classLoad
- ).
- ] ifTrue:[
- fullProtocol ifTrue:[
- labels := #(
- 'hierarchy'
- 'definition'
- 'comment'
- 'class instvars'
- ).
- selectors := #(
- classHierarchy
- classDefinition
- classComment
- classClassInstVars
- ).
- ] ifFalse:[
- labels := #(
- 'fileOut'
- 'printOut'
- 'printOut protocol'
- " 'printOut full protocol' "
- '-'
- 'SPAWN_CLASS'
- 'spawn full protocol'
- 'spawn hierarchy'
- 'spawn subclasses'
- '-'
- ).
- selectors := #(
- classFileOut
- classPrintOut
- classPrintOutProtocol
- " classPrintOutFullProtocol "
- nil
- classSpawn
- classSpawnFullProtocol
- classSpawnHierarchy
- classSpawnSubclasses
- nil
- ).
-
- fullClass ifFalse:[
- labels := labels , #(
- 'hierarchy'
- 'definition'
- 'comment'
- 'class instvars'
- "/ 'protocols'
- '-'
- ).
- selectors := selectors , #(
- classHierarchy
- classDefinition
- classComment
- classClassInstVars
- "/ classProtocols
- nil
- ).
- ].
-
- labels := labels , #(
- "/ 'variable search'
- 'class refs'
- '-'
- 'new class'
- 'new subclass'
- 'rename ...'
- 'remove'
- ).
- selectors := selectors , #(
- "/ variables
- classRefs
- nil
- classNewClass
- classNewSubclass
- classRename
- classRemove
- ).
- currentClass wasAutoloaded ifTrue:[
- labels := labels , #(
- 'unload'
- ).
- selectors := selectors , #(
- classUnload
- ).
- ]
- ]
- ].
- ].
+ currentClass isNil ifTrue:[
+ labels := #(
+ 'new class'
+ ).
+ selectors := #(
+ classNewClass
+ ).
+ ] ifFalse:[
+ currentClass isLoaded ifFalse:[
+ labels := #(
+ 'definition'
+ '-'
+ 'new class'
+ '-'
+ 'load '
+ ).
+ selectors := #(
+ classDefinition
+ nil
+ classNewClass
+ nil
+ classLoad
+ ).
+ ] ifTrue:[
+ fullProtocol ifTrue:[
+ labels := #(
+ 'hierarchy'
+ 'definition'
+ 'comment'
+ 'class instvars'
+ ).
+ selectors := #(
+ classHierarchy
+ classDefinition
+ classComment
+ classClassInstVars
+ ).
+ ] ifFalse:[
+ labels := #(
+ 'fileOut'
+ 'printOut'
+ 'printOut protocol'
+ " 'printOut full protocol' "
+ '-'
+ 'SPAWN_CLASS'
+ 'spawn full protocol'
+ 'spawn hierarchy'
+ 'spawn subclasses'
+ '-'
+ ).
+ selectors := #(
+ classFileOut
+ classPrintOut
+ classPrintOutProtocol
+ " classPrintOutFullProtocol "
+ nil
+ classSpawn
+ classSpawnFullProtocol
+ classSpawnHierarchy
+ classSpawnSubclasses
+ nil
+ ).
+
+ fullClass ifFalse:[
+ labels := labels , #(
+ 'hierarchy'
+ 'definition'
+ 'comment'
+ 'class instvars'
+ "/ 'protocols'
+ '-'
+ ).
+ selectors := selectors , #(
+ classHierarchy
+ classDefinition
+ classComment
+ classClassInstVars
+ "/ classProtocols
+ nil
+ ).
+ ].
+
+ labels := labels , #(
+ "/ 'variable search'
+ 'class refs'
+ '-'
+ 'new class'
+ 'new subclass'
+ 'rename ...'
+ 'remove'
+ ).
+ selectors := selectors , #(
+ "/ variables
+ classRefs
+ nil
+ classNewClass
+ classNewSubclass
+ classRename
+ classRemove
+ ).
+ currentClass wasAutoloaded ifTrue:[
+ labels := labels , #(
+ 'unload'
+ ).
+ selectors := selectors , #(
+ classUnload
+ ).
+ ]
+ ]
+ ].
+ ].
].
m := PopUpMenu
- labels:(resources array:labels)
- selectors:selectors.
+ labels:(resources array:labels)
+ selectors:selectors.
(currentClass isNil
or:[currentClass sourceCodeManager isNil]) ifTrue:[
- m disableAll:#(classRevisionInfo classLoadRevision classCheckin classCompareWithNewestInRepository).
+ m disableAll:#(classRevisionInfo classLoadRevision classCheckin classCompareWithNewestInRepository).
].
^ m
- "Modified: 7.12.1995 / 23:56:14 / cg"
+ "Modified: 12.12.1995 / 18:54:28 / cg"
!
classNewClass
@@ -1642,38 +1646,42 @@
"check a class into the source repository"
currentClass isLoaded ifFalse:[
- self warn:'cannot checkin unloaded classes.'.
- ^ self.
+ self warn:'cannot checkin unloaded classes.'.
+ ^ self.
].
self doClassMenu:[:currentClass |
- |logMessage info mgr|
-
- mgr := (currentClass sourceCodeManager).
- (info := mgr sourceInfoOfClass:currentClass) isNil ifTrue:[
- ^ self classCreateSourceContainerFor:currentClass
- ].
-
- logMessage := Dialog
- request:'enter a log message:'
- initialAnswer:lastSourceLogMessage
- onCancel:nil.
-
- logMessage notNil ifTrue:[
- lastSourceLogMessage := logMessage.
- self busyLabel:'checking in %1' with:currentClass name.
- (mgr checkinClass:currentClass logMessage:logMessage) ifFalse:[
- self warn:'checkin failed'.
- ].
- aspect == #revisionInfo ifTrue:[
- self classListUpdate
- ].
- self normalLabel.
- ]
+ |logMessage info mgr|
+
+ mgr := (currentClass sourceCodeManager).
+ info := mgr sourceInfoOfClass:currentClass.
+ (info isNil
+ or:[(info at:#classFileName ifAbsent:nil) isNil
+ or:[(info at:#module ifAbsent:nil) isNil
+ or:[(info at:#directory ifAbsent:nil) isNil]]]) ifTrue:[
+ ^ self classCreateSourceContainerFor:currentClass
+ ].
+
+ logMessage := Dialog
+ request:'enter a log message:'
+ initialAnswer:lastSourceLogMessage
+ onCancel:nil.
+
+ logMessage notNil ifTrue:[
+ lastSourceLogMessage := logMessage.
+ self busyLabel:'checking in %1' with:currentClass name.
+ (mgr checkinClass:currentClass logMessage:logMessage) ifFalse:[
+ self warn:'checkin failed'.
+ ].
+ aspect == #revisionInfo ifTrue:[
+ self classListUpdate
+ ].
+ self normalLabel.
+ ]
]
"Created: 23.11.1995 / 11:41:38 / cg"
- "Modified: 9.12.1995 / 21:19:08 / cg"
+ "Modified: 12.12.1995 / 23:10:11 / cg"
!
classCompareWithNewestInRepository
@@ -1681,62 +1689,71 @@
with the most recent version found in the repository."
currentClass isLoaded ifFalse:[
- self warn:'cannot compare unloaded classes.'.
- ^ self.
+ self warn:'cannot compare unloaded classes.'.
+ ^ self.
].
self doClassMenu:[:currentClass |
- |aStream comparedSource currentSource v rev revString mgr|
-
- mgr := currentClass sourceCodeManager.
-
- rev := Dialog request:'compare to revision: (empty for newest)'.
- rev notNil ifTrue:[
- rev withoutSpaces isEmpty ifTrue:[
- self busyLabel:'extracting newest %1' with:currentClass name.
- aStream := mgr mostRecentSourceStreamForClassNamed:currentClass name.
- revString := 'newest'
- ] ifFalse:[
- self busyLabel:'extracting previous %1' with:currentClass name.
- aStream := mgr sourceStreamFor:currentClass revision:rev.
- revString := rev
- ].
- aStream isNil ifTrue:[
- self warn:'could not extract source from repository'.
- ^ self
- ].
- comparedSource := aStream contents.
- aStream close.
-
- self busyLabel:'generating current source ...' with:nil.
-
- aStream := '' writeStream.
- currentClass fileOutOn:aStream withTimeStamp:false.
- currentSource := aStream contents.
- aStream close.
-
- self busyLabel:'comparing ...' with:nil.
- v := DiffTextView
- openOn:currentSource label:'current (' , currentClass revision , ')'
- and:comparedSource label:'repository (' , revString , ')'.
- v label:'comparing ' , currentClass name.
- self normalLabel.
- ]
+ |aStream comparedSource currentSource v rev revString thisRevString mgr|
+
+ mgr := currentClass sourceCodeManager.
+
+ rev := Dialog request:'compare to revision: (empty for newest)'.
+ rev notNil ifTrue:[
+ rev withoutSpaces isEmpty ifTrue:[
+ self busyLabel:'extracting newest %1' with:currentClass name.
+ aStream := mgr mostRecentSourceStreamForClassNamed:currentClass name.
+ revString := 'newest'
+ ] ifFalse:[
+ self busyLabel:'extracting previous %1' with:currentClass name.
+ aStream := mgr sourceStreamFor:currentClass revision:rev.
+ revString := rev
+ ].
+ aStream isNil ifTrue:[
+ self warn:'could not extract source from repository'.
+ ^ self
+ ].
+ comparedSource := aStream contents.
+ aStream close.
+
+ self busyLabel:'generating current source ...' with:nil.
+
+ aStream := '' writeStream.
+ currentClass fileOutOn:aStream withTimeStamp:false.
+ currentSource := aStream contents.
+ aStream close.
+
+ self busyLabel:'comparing ...' with:nil.
+ thisRevString := currentClass revision.
+ thisRevString isNil ifTrue:[
+ thisRevString := '(no revision'
+ ].
+ v := DiffTextView
+ openOn:currentSource label:'current (' , thisRevString , ')'
+ and:comparedSource label:'repository (' , revString , ')'.
+ v label:'comparing ' , currentClass name.
+ self normalLabel.
+ ]
]
"Created: 14.11.1995 / 16:43:15 / cg"
- "Modified: 9.12.1995 / 21:57:10 / cg"
+ "Modified: 12.12.1995 / 21:32:23 / cg"
!
classCreateSourceContainerFor:aClass
"let user specify the source-repository values for aClass"
- self classDefineSourceContainerFor:aClass title:(resources string:'CREATE_REPOSITORY' with:currentClass name) withCRs.
-
- "Modified: 9.12.1995 / 17:43:48 / cg"
-!
-
-classDefineSourceContainerFor:aClass title:aTitle
+ self
+ classDefineSourceContainerFor:aClass
+ title:(resources string:'Repository information for %1' with:aClass name)
+ text:(resources string:'CREATE_REPOSITORY' with:currentClass name)
+ createDirectories:true
+ createContainer:true.
+
+ "Modified: 12.12.1995 / 18:58:38 / cg"
+!
+
+classDefineSourceContainerFor:aClass title:title text:boxText createDirectories:createDirs createContainer:createContainer
"let user specify the source-repository values for aClass"
|box
@@ -1746,8 +1763,8 @@
check y component info fn project nm mgr|
aClass isLoaded ifFalse:[
- self warn:'please load the class first'.
- ^ self.
+ self warn:'please load the class first'.
+ ^ self.
].
"/
@@ -1760,14 +1777,14 @@
"/ try to extract some useful defaults from the current project
"/
(Project notNil and:[(project := Project current) notNil]) ifTrue:[
- (nm := project repositoryDirectory) isNil ifTrue:[
- nm := project name
- ].
- packageHolder value:nm.
-
- (nm := project repositoryModule) notNil ifTrue:[
- moduleHolder value:nm
- ].
+ (nm := project repositoryDirectory) isNil ifTrue:[
+ nm := project name
+ ].
+ packageHolder value:nm.
+
+ (nm := project repositoryModule) notNil ifTrue:[
+ moduleHolder value:nm
+ ].
].
"/
@@ -1776,23 +1793,27 @@
"/
info := (mgr := aClass sourceCodeManager) sourceInfoOfClass:aClass.
info notNil ifTrue:[
- (info includesKey:#module) ifTrue:[
- moduleHolder value:(info at:#module).
- ].
- (info includesKey:#directory) ifTrue:[
- packageHolder value:(info at:#directory).
- ].
- (info includesKey:#expectedFileName) ifTrue:[
- fn := (info at:#expectedFileName).
- ] ifFalse:[
- (info includesKey:#classFileName) ifTrue:[
- fn := (info at:#classFileName).
- ]
- ]
+ (info includesKey:#module) ifTrue:[
+ moduleHolder value:(info at:#module).
+ ].
+ (info includesKey:#directory) ifTrue:[
+ packageHolder value:(info at:#directory).
+ ].
+ (info includesKey:#expectedFileName) ifTrue:[
+ fn := (info at:#expectedFileName).
+ ] ifFalse:[
+ (info includesKey:#fileName) ifTrue:[
+ fn := (info at:#fileName).
+ ] ifFalse:[
+ (info includesKey:#classFileName) ifTrue:[
+ fn := (info at:#classFileName) , '.st'.
+ ]
+ ]
+ ]
].
fn isNil ifTrue:[
- fn := (Smalltalk fileNameForClass:aClass) , '.st'.
+ fn := (Smalltalk fileNameForClass:aClass) , '.st'.
].
fileNameHolder := fn asValue.
@@ -1805,10 +1826,12 @@
"/ open a dialog for this
"/
box := DialogBox new.
- box label:(resources string:'Repository information for %1' with:aClass name).
-
- component := box addTextLabel:(resources string:'CREATE_REPOSITORY' with:currentClass name) withCRs.
+ box label:title.
+
+ component := box addTextLabel:boxText withCRs.
component adjust:#left; borderWidth:0.
+ box addVerticalSpace.
+ box addVerticalSpace.
y := box yPosition.
component := box addTextLabel:(resources string:'Module:').
@@ -1841,64 +1864,80 @@
box showAtPointer.
box accepted ifTrue:[
- aClass revisionString isNil ifTrue:[
- (self confirm:(resources string:'%1 does not have any revision info (#version method)\\Shall I create one ?' with:aClass name) withCRs)
- ifFalse:[
- ^ self
- ].
- aClass updateVersionMethodFor:(mgr initialRevisionStringFor:aClass).
- ].
-
- module := moduleHolder value withoutSpaces.
- package := packageHolder value withoutSpaces.
- fileName := fileNameHolder value withoutSpaces.
-
- "/
- "/ check for the module
- "/
- (mgr checkForExistingModule:module) ifFalse:[
- (self confirm:(resources string:'%1 is a new module.\\create it ?' with:module) withCRs) ifFalse:[
- ^ self.
- ].
- (mgr createModule:module) ifFalse:[
- self warn:(resources string:'cannot create new module: %1' with:module).
- ^ self.
- ]
- ].
-
- "/
- "/ check for the package
- "/
- (mgr checkForExistingModule:module package:package) ifFalse:[
- (self confirm:(resources string:'%1 is a new package (in module %2).\\create it ?' with:package with:module) withCRs) ifFalse:[
- ^ self.
- ].
- (mgr createModule:module package:package) ifFalse:[
- self warn:(resources string:'cannot create new package: %1 (in module %2)' with:package with:module).
- ^ self.
- ]
- ].
-
- "/
- "/ check for the container itself
- "/
- (mgr checkForExistingContainerInModule:module package:package container:fileName) ifTrue:[
- self warn:(resources string:'container for %1 already exists in %2/%3.\\You have to destroy the old one or use another name.' with:fileName with:module with:package) withCRs.
- ^ self
- ].
-
- (mgr
- createContainerFor:aClass
- inModule:module
- package:package
- container:fileName) ifFalse:[
- self warn:(resources string:'failed to create container.').
- ^ self.
- ].
+ module := moduleHolder value withoutSpaces.
+ package := packageHolder value withoutSpaces.
+ fileName := fileNameHolder value withoutSpaces.
+
+ aClass revisionString isNil ifTrue:[
+ (self confirm:(resources string:'%1 does not have any revision info (#version method)\\Shall I create one ?' with:aClass name) withCRs)
+ ifFalse:[
+ ^ self
+ ].
+ aClass updateVersionMethodFor:(mgr initialRevisionStringFor:aClass
+ inModule:module
+ package:package
+ container:fileName).
+ ].
+
+ "/
+ "/ check for the module
+ "/
+ (mgr checkForExistingModule:module) ifFalse:[
+ createDirs ifFalse:[
+ self warn:(resources string:'a module named %1 does not exist in the source code management' with:module).
+ ^ self
+ ].
+ (self confirm:(resources string:'%1 is a new module.\\create it ?' with:module) withCRs) ifFalse:[
+ ^ self.
+ ].
+ (mgr createModule:module) ifFalse:[
+ self warn:(resources string:'cannot create new module: %1' with:module).
+ ^ self.
+ ]
+ ].
+
+ "/
+ "/ check for the package
+ "/
+ (mgr checkForExistingModule:module package:package) ifFalse:[
+ createDirs ifFalse:[
+ self warn:(resources string:'a package named %1 does not exist module %2' with:module with:package).
+ ^ self
+ ].
+ (self confirm:(resources string:'%1 is a new package (in module %2).\\create it ?' with:package with:module) withCRs) ifFalse:[
+ ^ self.
+ ].
+ (mgr createModule:module package:package) ifFalse:[
+ self warn:(resources string:'cannot create new package: %1 (in module %2)' with:package with:module).
+ ^ self.
+ ]
+ ].
+
+ "/
+ "/ check for the container itself
+ "/
+ (mgr checkForExistingContainerInModule:module package:package container:fileName) ifTrue:[
+ self warn:(resources string:'container for %1 already exists in %2/%3.\\You have to destroy the old one or use another name.' with:fileName with:module with:package) withCRs.
+ ^ self
+ ] ifFalse:[
+ createContainer ifFalse:[
+ self warn:(resources string:'no container exists for %1 in %2/%3' with:fileName with:module with:package).
+ ^ self
+ ]
+ ].
+
+ (mgr
+ createContainerFor:aClass
+ inModule:module
+ package:package
+ container:fileName) ifFalse:[
+ self warn:(resources string:'failed to create container.').
+ ^ self.
+ ].
].
box destroy
- "Modified: 9.12.1995 / 21:51:54 / cg"
+ "Modified: 12.12.1995 / 19:57:21 / cg"
!
classLoadRevision
@@ -1973,6 +2012,26 @@
"Modified: 9.12.1995 / 22:32:04 / cg"
!
+classModifyContainer
+ "check a class into the source repository"
+
+ currentClass isLoaded ifFalse:[
+ self warn:'cannot checkin unloaded classes.'.
+ ^ self.
+ ].
+
+ self doClassMenu:[:currentClass |
+ self
+ classDefineSourceContainerFor:currentClass
+ title:(resources string:'Repository information for %1' with:currentClass name)
+ text:'defining/changing the source code container'
+ createDirectories:false createContainer:false.
+ ]
+
+ "Created: 23.11.1995 / 11:41:38 / cg"
+ "Modified: 12.12.1995 / 18:58:02 / cg"
+!
+
classRevisionInfo
"show current classes revision info in codeView"
@@ -6172,6 +6231,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.67 1995-12-12 12:24:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.68 1995-12-12 22:11:41 cg Exp $'
! !
BrowserView initialize!