--- a/AbstractSourceCodeManager.st Thu Nov 13 12:29:22 2003 +0100
+++ b/AbstractSourceCodeManager.st Thu Nov 13 12:29:35 2003 +0100
@@ -563,13 +563,24 @@
"Modified: 12.9.1996 / 02:31:52 / cg"
!
-directoryFromContainerPath:containerPath
+directoryFromContainerPath:containerPath forClass:aClass
+ "given a full path as in an RCS header,
+ extract the directory (i.e. package)."
+
+ ^ self directoryFromContainerPath:containerPath forPackage:(aClass package)
+
+ "
+ CVSSourceCodeManager directoryFromContainerPath:'/files/CVS/stx/libbasic/Array.st' forClass:Array
+ "
+!
+
+directoryFromContainerPath:containerPath forPackage:packageID
"given a full path as in an RCS header,
extract the directory (i.e. package)."
|path idx|
- path := self pathInRepositoryFrom:containerPath.
+ path := self pathInRepositoryFrom:containerPath forPackage:packageID.
path isNil ifTrue:[^ nil].
"/ these are always UNIX filenames ...
@@ -625,12 +636,22 @@
"Modified: 11.11.1996 / 16:04:39 / cg"
!
-moduleFromContainerPath:containerPath
+moduleFromContainerPath:containerPath forClass:aClass
+ "given a full path as in an RCS header, extract the module."
+
+ ^ self moduleFromContainerPath:containerPath forPackage:aClass package
+
+ "
+ SourceCodeManager moduleFromContainerPath:'/files/CVS/stx/libbasic/Array.st' forClass:Array
+ "
+!
+
+moduleFromContainerPath:containerPath forPackage:packageID
"given a full path as in an RCS header, extract the module."
|path idx|
- path := self pathInRepositoryFrom:containerPath.
+ path := self pathInRepositoryFrom:containerPath forPackage:packageID.
path isNil ifTrue:[^ nil].
"/ these are always UNIX filenames
@@ -664,7 +685,7 @@
"Modified: 12.9.1996 / 02:32:19 / cg"
!
-pathInRepositoryFrom:containerPath
+pathInRepositoryFrom:containerPath forPackage:packageID
"this tries to extract the path within a repository, given some path
as present in an RCS Header string.
Typically, this ought to be that string directly;
@@ -676,34 +697,50 @@
|top lastTop idx|
- containerPath notNil ifTrue:[
- top := self repositoryTopDirectory.
- top notNil ifTrue:[
- (containerPath startsWith:(top , '/')) ifTrue:[
- ^ containerPath copyFrom:(top size + 2).
- ].
- (containerPath startsWith:(top)) ifTrue:[
- ^ containerPath copyFrom:(top size + 1).
- ].
+ containerPath isNil ifTrue:[^ nil].
+
+ packageID notNil ifTrue:[
+ idx := containerPath indexOfSubCollection:(packageID copyReplaceAll:$: with:$/).
+ idx ~~ 0 ifTrue:[
+ ^ containerPath copyFrom:idx.
+ ].
+ ].
+
+ "/
+ "/ the following is heuristics, in case that the packageID is not known
+ "/ (should not be required)
+ "/
+ top := self repositoryTopDirectory.
+ top notNil ifTrue:[
- "/ hardcase - the repository-filename in the versionInfo
- "/ does no match my repository top.
- "/ check for mangled prefix (happens with symbolic links)
+ (containerPath startsWith:(top , '/')) ifTrue:[
+ ^ containerPath copyFrom:(top size + 2).
+ ].
+ (containerPath startsWith:(top)) ifTrue:[
+ ^ containerPath copyFrom:(top size + 1).
+ ].
- lastTop := '/' , top asFilename baseName, '/'.
- idx := containerPath indexOfSubCollection:lastTop.
- idx ~~ 0 ifTrue:[
- ('SourceCodeManager [warning]: warning: repository path mismatch: ' , (containerPath copyTo:idx-1) , lastTop , ' vs. ' , top , '/') infoPrintCR.
- 'SourceCodeManager [info]: warning: assuming that mismatch is ok.' infoPrintCR.
- ^ containerPath copyFrom:(idx + lastTop size).
- ]
+ "/ hardcase - the repository-filename in the versionInfo
+ "/ does not match my repository top.
+ "/ check for mangled prefix (happens with symbolic links)
+
+ lastTop := '/' , top asFilename baseName, '/'.
+ idx := containerPath indexOfSubCollection:lastTop.
+ idx ~~ 0 ifTrue:[
+ ('SourceCodeManager [warning]: warning: repository path mismatch: ' , (containerPath copyTo:idx-1) , lastTop , ' vs. ' , top , '/') infoPrintCR.
+ 'SourceCodeManager [info]: warning: assuming that mismatch is ok.' infoPrintCR.
+ ^ containerPath copyFrom:(idx + lastTop size).
]
].
+
^ nil
"
- SourceCodeManager pathInRepositoryFrom:'/files/CVS/stx/libbasic/Array.st'
- SourceCodeManager pathInRepositoryFrom:'/phys/ibm/CVS/stx/libbasic/Array.st'
+ SourceCodeManager pathInRepositoryFrom:'/files/CVS/stx/libbasic/Array.st' forPackage:Array package
+ SourceCodeManager pathInRepositoryFrom:'/phys/ibm/CVS/stx/libbasic/Array.st' forPackage:Array package
+
+ SourceCodeManager pathInRepositoryFrom:'/files/CVS/stx/libbasic/Array.st' forPackage:nil
+ SourceCodeManager pathInRepositoryFrom:'/phys/ibm/CVS/stx/libbasic/Array.st' forPackage:nil
"
"Created: 25.11.1995 / 18:42:20 / cg"
@@ -858,11 +895,11 @@
revInfo notNil ifTrue:[
(revInfo includesKey:#repositoryPathName) ifTrue:[
container := revInfo at:#repositoryPathName ifAbsent:nil.
- moduleFromVersion := self moduleFromContainerPath:container.
+ moduleFromVersion := self moduleFromContainerPath:container forClass:aClass.
moduleFromVersion notNil ifTrue:[
newInfo at:#module put:moduleFromVersion.
].
- directoryFromVersion := self directoryFromContainerPath:container.
+ directoryFromVersion := self directoryFromContainerPath:container forClass:aClass.
directoryFromVersion notNil ifTrue:[
newInfo at:#directory put:directoryFromVersion.
].
@@ -1408,21 +1445,23 @@
"return a dictionary filled with revision info.
This extracts the relevant info from aString."
- |words info nm|
+ |words firstWord info nm|
info := IdentityDictionary new.
words := aString asCollectionOfWords.
words notEmpty ifTrue:[
+ firstWord := words at:1.
+
"/
"/ supported formats:
"/
- "/ $-Header: pathName rev date time user state $
+ "/ $-Header: pathName rev date time user state $
"/ $-Revision: rev $
- "/ $-Id: fileName rev date time user state $
+ "/ $-Id: fileName rev date time user state $
"/
- ((words at:1) = '$Header:') ifTrue:[
+ (firstWord = '$Header:') ifTrue:[
nm := words at:2.
info at:#repositoryPathName put:nm.
(nm endsWith:',v') ifTrue:[
@@ -1442,11 +1481,13 @@
].
^ info
].
- ((words at:1) = '$Revision:') ifTrue:[
+
+ (firstWord = '$Revision:') ifTrue:[
info at:#revision put:(words at:2).
^ info
].
- ((words at:1) = '$Id:') ifTrue:[
+
+ (firstWord = '$Id:') ifTrue:[
info at:#fileName put:(words at:2).
info at:#revision put:(words at:3).
info at:#date put:(words at:4).
@@ -2066,7 +2107,7 @@
!AbstractSourceCodeManager class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/AbstractSourceCodeManager.st,v 1.164 2003-10-08 20:13:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/AbstractSourceCodeManager.st,v 1.165 2003-11-13 11:29:02 cg Exp $'
! !
AbstractSourceCodeManager initialize!
--- a/HTMLDocGenerator.st Thu Nov 13 12:29:22 2003 +0100
+++ b/HTMLDocGenerator.st Thu Nov 13 12:29:35 2003 +0100
@@ -1564,7 +1564,7 @@
path := revInfo at:#repositoryPathName ifAbsent:(pckgInfo at:#repositoryPathName ifAbsent:nil).
path notNil ifTrue:[
SourceCodeManager notNil ifTrue:[
- text := SourceCodeManager directoryFromContainerPath:path.
+ text := SourceCodeManager directoryFromContainerPath:path forClass:aClass.
].
text isNil ifTrue:[text := '?'].
] ifFalse:[
@@ -1578,7 +1578,7 @@
path := revInfo at:#repositoryPathName ifAbsent:(pckgInfo at:#repositoryPathName ifAbsent:nil).
path notNil ifTrue:[
SourceCodeManager notNil ifTrue:[
- text := SourceCodeManager moduleFromContainerPath:path.
+ text := SourceCodeManager moduleFromContainerPath:path forClass:aClass.
].
text isNil ifTrue:[text := '?'].
] ifFalse:[
@@ -2426,5 +2426,5 @@
!HTMLDocGenerator class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/HTMLDocGenerator.st,v 1.69 2003-11-10 16:12:22 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/HTMLDocGenerator.st,v 1.70 2003-11-13 11:29:35 cg Exp $'
! !