--- a/Smalltalk.st Tue Aug 10 17:17:12 2004 +0200
+++ b/Smalltalk.st Thu Aug 12 11:20:50 2004 +0200
@@ -3375,101 +3375,65 @@
abbreviation (className-to-fileName mapping) table.
This takes some time ..."
- |s2 l clsName abbrev package cat numClassInstVars cls words w abbrevs oldAbbrev nameKey|
-
- "/ on the fly, update the abbreviations
-
- CachedAbbreviations isNil ifTrue:[
- CachedAbbreviations := IdentityDictionary new.
- ].
- abbrevs := CachedAbbreviations.
+ |s2 l clsName abbrev package cat numClassInstVars words w|
KnownPackages isNil ifTrue:[
- KnownPackages := Set new.
+ KnownPackages := Set new.
].
"/ yes, create any required nameSpace, without asking user.
Class createNameSpaceQuerySignal answer:true do:[
- [anAbbrevFileStream atEnd] whileFalse:[
- l := anAbbrevFileStream nextLine withoutSeparators.
- l notEmpty ifTrue:[
- "/ must do it manually, caring for quoted strings.
+ [anAbbrevFileStream atEnd] whileFalse:[
+ l := anAbbrevFileStream nextLine withoutSeparators.
+ l notEmpty ifTrue:[
+ "/ must do it manually, caring for quoted strings.
"/ words := line asCollectionOfWords.
- words := OrderedCollection new.
- s2 := l readStream.
- [s2 atEnd] whileFalse:[
- s2 skipSeparators.
- s2 peek == $' ifTrue:[
- s2 next.
- w := s2 upTo:$'.
- s2 skipSeparators.
- ] ifFalse:[
- w := s2 upToSeparator
- ].
- words add:w
- ].
- words size < 3 ifTrue:[
- 'Smalltalk [warning]: bad abbrev entry' errorPrint.
- anAbbrevFileStream isFileStream ifTrue:[
- ' (in ''' errorPrint.
- anAbbrevFileStream pathName errorPrint.
- ''')' errorPrint
- ].
- ': ' errorPrint. l errorPrintCR
- ] ifFalse:[
- clsName := (words at:1) asSymbol.
- abbrev := (words at:2).
- package := (words at:3) asSymbol.
- cat := words at:4 ifAbsent:nil.
- numClassInstVars := words at:5 ifAbsent:'0'.
- numClassInstVars := Integer readFrom:numClassInstVars onError:[0].
+ words := OrderedCollection new.
+ s2 := l readStream.
+ [s2 atEnd] whileFalse:[
+ s2 skipSeparators.
+ s2 peek == $' ifTrue:[
+ s2 next.
+ w := s2 upTo:$'.
+ s2 skipSeparators.
+ ] ifFalse:[
+ w := s2 upToSeparator
+ ].
+ words add:w
+ ].
+ words size < 3 ifTrue:[
+ 'Smalltalk [warning]: bad abbrev entry' errorPrint.
+ anAbbrevFileStream isFileStream ifTrue:[
+ ' (in ''' errorPrint.
+ anAbbrevFileStream pathName errorPrint.
+ ''')' errorPrint
+ ].
+ ': ' errorPrint. l errorPrintCR
+ ] ifFalse:[
+ clsName := (words at:1) asSymbol.
+ abbrev := (words at:2).
+ package := (words at:3) asSymbol.
+ cat := words at:4 ifAbsent:nil.
+ numClassInstVars := words at:5 ifAbsent:'0'.
+ numClassInstVars := Integer readFrom:numClassInstVars onError:[0].
"/ KnownPackages add:package.
- (cat size == 0) ifTrue:[
- cat := 'autoloaded'
- ].
-
- "/ on the fly, update the abbreviations
- clsName ~= abbrev ifTrue:[
- nameKey := clsName asSymbol.
- oldAbbrev := abbrevs at:nameKey ifAbsent:nil.
- (oldAbbrev notNil and:[oldAbbrev ~= abbrev]) ifTrue:[
- StandAlone ifFalse:[
- ('Smalltalk [warning]: conflict for: ' , clsName , ' in ' , (anAbbrevFileStream pathName)) infoPrintCR.
- ('Smalltalk [warning]: (' , oldAbbrev , ' <-> ' , abbrev , ')') infoPrintCR
- ].
- ] ifFalse:[
- cls := self classNamed:abbrev.
- cls notNil ifTrue:[
- cls name ~= clsName ifTrue:[
- "/ ok, there is a class named after this abbrev ...
- "/ this is only a conflict, if the other class has no
- "/ abbreviation (or the same).
- (abbrevs at:(cls name asSymbol) ifAbsent:cls name) = abbrev ifTrue:[
- cls isNameSpace ifFalse:[
- package = cls package ifTrue:[
- StandAlone ifFalse:[
- ('Smalltalk [warning]: conflict for: ' , cls name , ' in ' , (anAbbrevFileStream pathName)) infoPrintCR.
- ('Smalltalk [warning]: (' , clsName , ' -> ' , abbrev , ')') infoPrintCR
- ]
- ]
- ]
- ]
- ]
- ].
- ].
- abbrevs at:nameKey put:abbrev.
- ].
-
- "/ ' autoloaded: ' print. clsName print. ' in ' print. cat printCR.
-
- self installAutoloadedClassNamed:clsName category:cat package:package revision:nil numClassInstVars:numClassInstVars.
- ]
- ]
- ]
+ (cat size == 0) ifTrue:[
+ cat := 'autoloaded'
+ ].
+
+ "/ on the fly, update the abbreviations
+ self setFilename:abbrev forClass:clsName package:package.
+
+ "/ ' autoloaded: ' print. clsName print. ' in ' print. cat printCR.
+
+ self installAutoloadedClassNamed:clsName category:cat package:package revision:nil numClassInstVars:numClassInstVars.
+ ]
+ ]
+ ]
]
!
@@ -5245,73 +5209,39 @@
"read classname to filename mappings from aStream.
sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
- |abbrevs line words nm abbrev pkg key oldAbbrev cls s w|
-
- abbrevs := CachedAbbreviations.
+ |line words nm abbrev pkg s w|
[aStream atEnd] whileFalse:[
- line := aStream nextLine.
- line notNil ifTrue:[
- (line startsWith:'#') ifFalse:[
-
- "/ must do it manually, caring for quoted strings.
+ line := aStream nextLine.
+ line notNil ifTrue:[
+ (line startsWith:'#') ifFalse:[
+
+ "/ must do it manually, caring for quoted strings.
"/ words := line asCollectionOfWords.
- words := OrderedCollection new.
- s := line readStream.
- [s atEnd] whileFalse:[
- s skipSeparators.
- s peek == $' ifTrue:[
- s next.
- w := s upTo:$'.
- s skipSeparators.
- ] ifFalse:[
- w := s upToSeparator
- ].
- words add:w
- ].
- words size >= 3 ifTrue:[
- nm := (words at:1) withoutSeparators.
- abbrev := (words at:2) withoutSeparators.
- pkg := (words at:3) withoutSeparators.
- nm ~= abbrev ifTrue:[
- key := nm asSymbol.
- oldAbbrev := abbrevs at:key ifAbsent:nil.
- oldAbbrev notNil ifTrue:[
- oldAbbrev ~= abbrev ifTrue:[
- StandAlone ifFalse:[
- ('Smalltalk [warning]: conflict for: ' , nm , ' in ' , (aStream pathName)) infoPrintCR.
- ('Smalltalk [warning]: (' , oldAbbrev , ' <-> ' , abbrev , ')') infoPrintCR
- ]
- ].
- ] ifFalse:[
- cls := self classNamed:abbrev.
-
- cls notNil ifTrue:[
- cls name ~= nm ifTrue:[
- "/ ok, there is a class named after this abbrev ...
- "/ this is only a conflict, if the other class has no
- "/ abbreviation (or the same).
- (abbrevs at:(cls name asSymbol) ifAbsent:cls name) = abbrev ifTrue:[
- cls isNameSpace ifFalse:[
- pkg = cls package ifTrue:[
- StandAlone ifFalse:[
- ('Smalltalk [warning]: conflict for: ' , cls name , ' in ' , (aStream pathName)) infoPrintCR.
- ('Smalltalk [warning]: (' , nm , ' -> ' , abbrev , ')') infoPrintCR
- ]
- ]
- ]
- ]
- ]
- ].
- abbrevs at:nm asSymbol put:abbrev.
- ]
- ]
- ] ifFalse:[
- ('Smalltalk [warning]: malformed line in ' , (aStream pathName)) infoPrintCR.
- ]
- ]
- ]
+ words := OrderedCollection new.
+ s := line readStream.
+ [s atEnd] whileFalse:[
+ s skipSeparators.
+ s peek == $' ifTrue:[
+ s next.
+ w := s upTo:$'.
+ s skipSeparators.
+ ] ifFalse:[
+ w := s upToSeparator
+ ].
+ words add:w
+ ].
+ words size >= 3 ifTrue:[
+ nm := (words at:1) withoutSeparators.
+ abbrev := (words at:2) withoutSeparators.
+ pkg := (words at:3) withoutSeparators.
+ self setFilename:abbrev forClass:nm package:pkg.
+ ] ifFalse:[
+ ('Smalltalk [warning]: malformed line in ' , (aStream pathName)) infoPrintCR.
+ ]
+ ]
+ ]
].
"Modified: / 13.12.1999 / 11:54:17 / cg"
@@ -5469,6 +5399,54 @@
"Modified: / 29.4.1999 / 15:06:43 / cg"
!
+setFilename:aFileNameString forClass:aClassNameString package:aPackageNameString
+ |classNameSymbol oldAbbrev cls abbrevs|
+
+ CachedAbbreviations isNil ifTrue:[
+ CachedAbbreviations := IdentityDictionary new.
+ ].
+
+ abbrevs := CachedAbbreviations.
+ aClassNameString ~= aFileNameString ifTrue:[
+ classNameSymbol := aClassNameString asSymbol.
+ oldAbbrev := abbrevs at:classNameSymbol ifAbsent:nil.
+ oldAbbrev notNil ifTrue:[
+ oldAbbrev ~= aFileNameString ifTrue:[
+ StandAlone ifFalse:[
+ ('Smalltalk [warning]: conflict for: ' , aClassNameString ,
+ ' in package ' , aPackageNameString) infoPrintCR.
+ ('Smalltalk [warning] overwriting with new: (' , oldAbbrev , ' <-> ' , aFileNameString , ')')
+ infoPrintCR
+ ]
+ ].
+ "overwrite old abbreviation with new one,
+ to allow fixing of bad abbrev files"
+ ].
+
+ cls := self classNamed:aFileNameString.
+ cls notNil ifTrue:[
+ cls name ~= aClassNameString ifTrue:[
+ "/ ok, there is a class named after this abbrev ...
+ "/ this is only a conflict, if the other class has no
+ "/ abbreviation (or the same).
+ (abbrevs at:(cls name asSymbol) ifAbsent:cls name) = aFileNameString ifTrue:[
+ cls isNameSpace ifFalse:[
+ aPackageNameString = cls package ifTrue:[
+ StandAlone ifFalse:[
+ ('Smalltalk [warning]: conflict for: ' , cls name ,
+ ' in package ' , aPackageNameString) infoPrintCR.
+ ('Smalltalk [warning]: (' , aClassNameString , ' -> ' , aFileNameString
+ , ')') infoPrintCR
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ abbrevs at:classNameSymbol put:aFileNameString.
+ ]
+!
+
sourceDirectoryNameOfClass:aClassOrClassName
"for a given class, return the pathname relative to TOP of the classes source code.
Read the files 'abbrev.stc' and 'liblist.stc' (which are created during the compilation process)
@@ -6395,5 +6373,5 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.649 2004-07-13 08:41:17 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.650 2004-08-12 09:20:50 stefan Exp $'
! !