hg/stx-libtool: comparison BrowserView.st

equal deleted inserted replaced

-:417ccb5b70b7
+:c41c71b6bf2b
 ]
 ].
 ((someArgument category = currentClassCategory)
 or:[currentClassCategory notNil
-and:[currentClassCategory startsWith:'*']]) ifTrue:[
+and:[currentClassCategory startsWith:$*]]) ifTrue:[
 self updateClassListWithScroll:false.
 ].
 someArgument category ~= currentClassCategory ifTrue:[
 "
 (changedObject isMethod) ifTrue:[
 ]
 "Created: / 4.1.1997 / 13:54:00 / cg"
-"Modified: / 4.3.1998 / 14:46:06 / cg"
+"Modified: / 5.3.1998 / 02:46:01 / cg"
 !
 refetchClass
 "after a class definition change in another browser,
 this is sent to update (otherwise, we'd still refer to the obsolete class)"
 "create a file 'categoryName' consisting of all classes in current category"
 |aStream fileName|
 self checkClassCategorySelected ifFalse:[^ self].
-(currentClassCategory startsWith:'*') ifTrue:[
+(currentClassCategory startsWith:$*) ifTrue:[
 self warn:(resources string:'try a real category').
 ^ self
 ].
 fileName := currentClassCategory asString , '.st'.
 ]
 ].
 self normalLabel.
 "Created: / 11.10.1997 / 16:38:29 / cg"
-"Modified: / 28.10.1997 / 14:35:50 / cg"
+"Modified: / 5.3.1998 / 02:45:17 / cg"
 !
 classCategoryFileOutBinaryEach
 "fileOut each class in the current category as binary bytecode."
 |mode|
-(currentClassCategory startsWith:'*') ifTrue:[
+(currentClassCategory startsWith:$*) ifTrue:[
-	self warn:(resources string:'try a real category').
+self warn:(resources string:'try a real category').
-	^ self
+^ self
 ].
 mode := Dialog choose:(resources string:'save including sources ?')
-		   labels:(resources array:#('cancel' 'discard' 'by file reference' 'include source'))
+labels:(resources array:#('cancel' 'discard' 'by file reference' 'include source'))
-		   values:#(nil #discard #reference #keep)
+values:#(nil #discard #reference #keep)
-		   default:#keep.
+default:#keep.
 mode isNil ifTrue:[^ self].
 self withBusyCursorDo:[
-	self allClassesInCategory:currentClassCategory do:[:aClass |
+self allClassesInCategory:currentClassCategory do:[:aClass |
-	    aClass isPrivate ifFalse:[
+aClass isPrivate ifFalse:[
-		(self listOfNamespaces includesIdentical:aClass nameSpace)
+(self listOfNamespaces includesIdentical:aClass nameSpace)
-		ifTrue:[
+ifTrue:[
-		    self busyLabel:'saving binary of: %1' with:aClass name.
+self busyLabel:'saving binary of: %1' with:aClass name.
-		    Class fileOutErrorSignal handle:[:ex |
+Class fileOutErrorSignal handle:[:ex |
-			self warn:'cannot create: %1' with:ex parameter.
+self warn:'cannot create: %1' with:ex parameter.
-			ex return.
+ex return.
-		    ] do:[
+] do:[
-			aClass binaryFileOutWithSourceMode:mode.
+aClass binaryFileOutWithSourceMode:mode.
-		    ]
+]
-		]
+]
-	    ]
+]
-	].
+].
-	self normalLabel.
+self normalLabel.
 ]
-"Created: 25.1.1996 / 17:27:45 / cg"
+"Created: / 25.1.1996 / 17:27:45 / cg"
-"Modified: 18.8.1997 / 15:42:30 / cg"
+"Modified: / 5.3.1998 / 02:45:30 / cg"
 !
 classCategoryFileOutEach
-(currentClassCategory startsWith:'*') ifTrue:[
+(currentClassCategory startsWith:$*) ifTrue:[
-	self warn:(resources string:'try a real category').
+self warn:(resources string:'try a real category').
-	^ self
+^ self
 ].
 self withBusyCursorDo:[
-	self allClassesInCategory:currentClassCategory do:[:aClass |
+self allClassesInCategory:currentClassCategory do:[:aClass |
-	    aClass isPrivate ifFalse:[
+aClass isPrivate ifFalse:[
-		(self listOfNamespaces includesIdentical:aClass nameSpace)
+(self listOfNamespaces includesIdentical:aClass nameSpace)
-		ifTrue:[
+ifTrue:[
-		    self busyLabel:'saving: %1' with:aClass name.
+self busyLabel:'saving: %1' with:aClass name.
-		    Class fileOutErrorSignal handle:[:ex |
+Class fileOutErrorSignal handle:[:ex |
-			self warn:'cannot fileOut: %1\(%2)' with:aClass name with:ex errorString.
+self warn:'cannot fileOut: %1\(%2)' with:aClass name with:ex errorString.
-			ex return.
+ex return.
-		    ] do:[
+] do:[
-			aClass fileOut
+aClass fileOut
-		    ]
+]
-		]
+]
-	    ]
+]
-	].
+].
-	self normalLabel.
+self normalLabel.
 ]
-"Modified: 18.8.1997 / 15:42:35 / cg"
+"Modified: / 5.3.1998 / 02:45:38 / cg"
 !
 classCategoryFindClass
 "find a class - and switch by default"
 "let user specify the source-repository values for aClass"
 |box className
 moduleHolder packageHolder fileNameHolder
 oldModule oldPackage oldFileName
-module package fileName
+module package fileName nameSpace nameSpacePrefix
 y component info project nm mgr creatingNew msg|
 aClass isLoaded ifFalse:[
 self warn:'please load the class first'.
 ^ false.
 (info includesKey:#directory) ifTrue:[
 package := (info at:#directory).
 ].
 ].
 fileName := mgr containerFromSourceInfo:info.
-aClass nameSpace ~~ Smalltalk ifTrue:[
+(nameSpace := aClass nameSpace) ~~ Smalltalk ifTrue:[
-(fileName startsWith:(aClass nameSpace name , '::')) ifTrue:[
+nameSpacePrefix := nameSpace name , '::'.
-fileName := fileName copyFrom:(aClass nameSpace name , '::') size + 1.
+(fileName startsWith:nameSpacePrefix) ifTrue:[
+fileName := fileName copyFrom:(nameSpacePrefix size + 1).
 ]
 ].
 "/        (info includesKey:#fileName) ifTrue:[
 "/            fileName := (info at:#fileName).
 "/        ] ifFalse:[
 ^ true
 ].
 box destroy.
 ^ false
-"Modified: / 1.2.1998 / 17:55:45 / cg"
+"Modified: / 5.3.1998 / 02:44:45 / cg"
 !
 classLoadNewRevision
 "let user specify a container and fileIn from there"
 className ownerName s|
 s := TextStream on:''.
 isNameSpace ifTrue:[
-	s nextPutAll:'Namespace name:''NewNameSpace'''.
+s nextPutAll:'Namespace name:''NewNameSpace'''.
-	s cr; cr.
+s cr; cr.
-	s emphasis:(self commentEmphasis).
+s emphasis:(self commentEmphasis).
-	s nextPutAll:'"
+s nextPutAll:'"
 Replace ''NewNameSpace'' by the desired name.
 Create the namespace by ''accepting'',
 either via the menu or the keyboard (usually CMD-A).
 "
 '.
-	^ s contents.
+^ s contents.
 ].
 withNameSpaceDirective :=
-	currentNamespace notNil
+currentNamespace notNil
-	and:[currentNamespace ~= '* all *'
+and:[currentNamespace ~= '* all *'
-	and:[currentNamespace ~= Smalltalk]].
+and:[currentNamespace ~= Smalltalk]].
 withNameSpaceDirective ifTrue:[
-	className := aSuperClass nameWithoutNameSpacePrefix.
+className := aSuperClass nameWithoutNameSpacePrefix.
-	s nextPutAll:('"{ Namespace: ''' , currentNamespace name , ''' }"').
+s nextPutAll:('"{ Namespace: ''' , currentNamespace name , ''' }"').
-	s cr; cr.
+s cr; cr.
 ] ifFalse:[
-	className := aSuperClass name.
+className := aSuperClass name.
 ].
 cat := categoryString.
-(cat isNil or:[cat startsWith:'*']) ifTrue:[
+(cat isNil or:[cat startsWith:$*]) ifTrue:[
-	cat := '* no category *'
+cat := '* no category *'
 ].
 nameProto := 'NewClass'.
 i := 1.
 isPrivate ifTrue:[
-	namePrefix := currentClass name , '::'.
+namePrefix := currentClass name , '::'.
-	existingNames := currentClass privateClasses.
+existingNames := currentClass privateClasses.
-	existingNames size > 0 ifTrue:[
+existingNames size > 0 ifTrue:[
-	    existingNames := existingNames collect:[:cls | cls name].
+existingNames := existingNames collect:[:cls | cls name].
-	]
+]
 ] ifFalse:[
-	namePrefix := ''.
+namePrefix := ''.
-	existingNames := Smalltalk keys
+existingNames := Smalltalk keys
 ].
 name := 'NewClass' , i printString.
 existingNames notNil ifTrue:[
-	nameProto := namePrefix , name.
+nameProto := namePrefix , name.
-	[nameProto knownAsSymbol and:[existingNames includes:nameProto asSymbol]] whileTrue:[
+[nameProto knownAsSymbol and:[existingNames includes:nameProto asSymbol]] whileTrue:[
-	    i := i + 1.
+i := i + 1.
-	    name := 'NewClass' , i printString.
+name := 'NewClass' , i printString.
-	    nameProto := namePrefix , name
+nameProto := namePrefix , name
-	].
+].
 ].
 s nextPutAll:className.
 isPrivate ifTrue:[
-	withNameSpaceDirective ifTrue:[
+withNameSpaceDirective ifTrue:[
-	    ownerName := currentClass nameWithoutNameSpacePrefix
+ownerName := currentClass nameWithoutNameSpacePrefix
-	] ifFalse:[
+] ifFalse:[
-	    ownerName := currentClass name
+ownerName := currentClass name
-	].
+].
-	s nextPutAll:(' subclass:#' , name  , '
+s nextPutAll:(' subclass:#' , name  , '
 ' , '    instanceVariableNames: ''''
 ' , '    classVariableNames: ''''
 ' , '    poolDictionaries: ''''
 ' , '    privateIn:' , ownerName)
 ] ifFalse:[
-	s nextPutAll:(' subclass:#' , name , '
+s nextPutAll:(' subclass:#' , name , '
 ' , '    instanceVariableNames: ''''
 ' , '    classVariableNames: ''''
 ' , '    poolDictionaries: ''''
 ' , '    category: ''').
-	cat notNil ifTrue:[
+cat notNil ifTrue:[
-	    s nextPutAll: cat
+s nextPutAll: cat
-	].
+].
-	s nextPutAll: ''''
+s nextPutAll: ''''
 ].
 s cr; cr.
 s emphasis:(self commentEmphasis).
 s nextPutAll:'
 "
 '.
 ^ s contents
-"Created: 23.12.1996 / 12:46:31 / cg"
+"Created: / 23.12.1996 / 12:46:31 / cg"
-"Modified: 29.8.1997 / 01:10:54 / cg"
+"Modified: / 5.3.1998 / 02:45:52 / cg"
 !
 doClassMenu:aBlock
 "a helper - check if class is selected and evaluate aBlock
 while showing waitCursor"
 ! !
 !BrowserView class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.371 1998-03-04 16:46:09 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.372 1998-03-05 12:50:05 cg Exp $'
 ! !
 BrowserView initialize!

changeset 1506	c41c71b6bf2b
parent 1503	5ad4c77262b1
child 1510	ec5dd071b570