Method.st
changeset 4669 828addb1c376
parent 4595 24446fd5d3e1
child 4751 174a92d4ba3f
--- a/Method.st	Thu Sep 02 23:14:43 1999 +0200
+++ b/Method.st	Thu Sep 02 23:26:53 1999 +0200
@@ -351,6 +351,27 @@
     "Created: 16.1.1997 / 01:25:52 / cg"
 !
 
+localSourceStream
+    "try to open a stream from a local source file,
+     searching in standard places."
+
+    |fileName aStream|
+
+    package notNil ifTrue:[
+        fileName := Smalltalk getSourceFileName:(package copyReplaceAll:$: with:$/) , '/' , source.
+        fileName notNil ifTrue:[
+            aStream := fileName asFilename readStream.
+            aStream notNil ifTrue:[^ aStream].
+        ].
+    ].
+    fileName := Smalltalk getSourceFileName:source.
+    fileName notNil ifTrue:[
+        aStream := fileName asFilename readStream.
+        aStream notNil ifTrue:[^ aStream].
+    ].
+    ^ nil
+!
+
 package
     "return the package-symbol"
 
@@ -378,16 +399,6 @@
     sourcePosition isNil ifTrue:[^ source].
 
     source notNil ifTrue:[
-"/
-"/ original (old) code:
-"/
-"/        aStream := Smalltalk systemFileStreamFor:('source/' , source).
-"/        aStream notNil ifTrue:[
-"/            aStream position:sourcePosition.
-"/            junk := aStream nextChunk.
-"/            aStream close
-"/        ]
-
         LastMethodSources notNil ifTrue:[
             junk := LastMethodSources at:self ifAbsent:nil.
             junk notNil ifTrue:[
@@ -415,125 +426,7 @@
             ].
         ].
 
-        "/ a negative sourcePosition indicates
-        "/ that this is a local file (not to be requested
-        "/ via the sourceCodeManager)
-        "/ This kludge was added, to allow sourceCode to be
-        "/ saved to a local source file (i.e. 'st.src')
-        "/ and having a clue for which file is meant later.
-
-        sourcePosition < 0 ifTrue:[
-            aStream := source asFilename readStream.
-            aStream isNil ifTrue:[
-                fileName := Smalltalk getSourceFileName:source.
-                fileName notNil ifTrue:[
-                    aStream := fileName asFilename readStream.
-                ].
-            ].
-        ].
-
-        aStream isNil ifTrue:[
-            "/
-            "/ if there is no SourceManager, look in standard places
-            "/ first
-            "/
-            (mgr := Smalltalk at:#SourceCodeManager) isNil ifTrue:[
-                package notNil ifTrue:[
-"/ 'try: ' print. ((package copyReplaceAll:$: with:$/)  , '/' , source) printCR.
-
-                    fileName := Smalltalk getSourceFileName:(package copyReplaceAll:$: with:$/) , '/' , source.
-                    fileName notNil ifTrue:[
-                        aStream := fileName asFilename readStream.
-"/ aStream printCR.
-                    ].
-                ].
-                aStream isNil ifTrue:[
-                    fileName := Smalltalk getSourceFileName:source.
-"/ 'try: ' print. source printCR.
-                    fileName notNil ifTrue:[
-                        aStream := fileName asFilename readStream.
-"/ aStream printCR.
-                    ]
-                ].
-            ].
-
-            aStream isNil ifTrue:[
-                "/
-                "/ nope - ask my class for the source (this also invokes the SCMgr)
-                "/
-                who := self who.
-                who notNil ifTrue:[
-                    myClass := who methodClass.
-"/ 'ask class for: ' print. source printCR.
-                    aStream := myClass sourceStreamFor:source.
-"/ aStream printCR.
-
-"/ the check below is no good -
-"/ the classes stream may be an HTTP-stream, cached fileStream
-"/ or whatever ...
-"/
-"/                    aStream pathName asFilename baseName ~= source asFilename baseName
-"/                    ifTrue:[
-"/                        "/ oops - not really
-"/                        'Method [info]: do not trust my classes source' infoPrintCR.
-"/                        aStream close.
-"/                        aStream := nil.
-"/                    ]
-                ].
-
-                aStream isNil ifTrue:[
-                    "/
-                    "/ nope - look in standard places 
-                    "/ (if there is a source-code manager - otherwise, we already did that)
-                    "/
-                    mgr notNil ifTrue:[
-                        package notNil ifTrue:[
-"/ 'try: ' print. ((package copyReplaceAll:$: with:$/)  , '/' , source) printCR.
-                            fileName := Smalltalk getSourceFileName:(package copyReplaceAll:$: with:$/) , '/' , source.
-                            fileName notNil ifTrue:[
-                                aStream := fileName asFilename readStream.
-"/ aStream printCR.
-                            ].
-                        ].
-                        aStream isNil ifTrue:[
-"/ 'try: ' print. source printCR.
-                            fileName := Smalltalk getSourceFileName:source.
-                            fileName notNil ifTrue:[
-                                aStream := fileName asFilename readStream.
-"/ aStream printCR.
-                            ]
-                        ]
-                    ].
-
-                    "/
-                    "/ final chance: try current directory
-                    "/
-                    aStream isNil ifTrue:[
-                        aStream := source asFilename readStream.
-"/ aStream printCR.
-                    ]
-                ].
-
-                (aStream isNil and:[who isNil and:[source notNil]]) ifTrue:[
-                    "/
-                    "/ mhmh - seems to be a method which used to be in some
-                    "/ class, but has been overwritten by another or removed.
-                    "/ (i.e. it has no containing class anyMore)
-                    "/ try to guess the class from the sourceFileName.
-                    "/ and retry.
-                    "/
-                    className := Smalltalk classNameForFile:source.
-                    className knownAsSymbol ifTrue:[
-                        myClass := Smalltalk at:className asSymbol ifAbsent:nil.
-                        myClass notNil ifTrue:[
-                            aStream := myClass sourceStreamFor:source.
-"/ aStream printCR.
-                        ]
-                    ]
-                ]                
-            ]
-        ].
-
+        aStream := self sourceStream.
         aStream notNil ifTrue:[
             Stream positionErrorSignal handle:[:ex |
                 ^ nil
@@ -608,6 +501,127 @@
     ^ sourcePosition abs
 
     "Modified: 16.1.1997 / 01:28:25 / cg"
+!
+
+sourceStream
+    "return an open sourceStream (needs positioning)"
+
+    |aStream fileName junk who myClass mgr className sep dir mod|
+
+    "
+     if sourcePosition is nonNil, its the fileName and
+     abs(sourcePosition) is the offset.
+     Otherwise, source is the real source
+    "
+    source isNil ifTrue:[^ nil].
+    sourcePosition isNil ifTrue:[^ nil].
+
+    "/ keep the last source file open, because open/close
+    "/ operations maybe slow on NFS-mounted file systems.
+    "/ Since the reference to the file is weak, it will be closed
+    "/ automatically if the file is not referenced for a while. 
+    "/ Neat trick.
+
+    LastFileLock critical:[
+        aStream := LastFileReference at:1.
+        LastFileReference at:1 put:0.
+
+        aStream == 0 ifTrue:[
+            aStream := nil.
+        ] ifFalse:[
+            LastSourceFileName = source ifFalse:[
+                aStream close.
+                aStream := nil.
+            ].
+        ].
+    ].
+
+    "/ a negative sourcePosition indicates
+    "/ that this is a local file (not to be requested
+    "/ via the sourceCodeManager)
+    "/ This kludge was added, to allow sourceCode to be
+    "/ saved to a local source file (i.e. 'st.src')
+    "/ and having a clue for which file is meant later.
+
+    sourcePosition < 0 ifTrue:[
+        aStream := source asFilename readStream.
+        aStream notNil ifTrue:[^ aStream].
+
+        fileName := Smalltalk getSourceFileName:source.
+        fileName notNil ifTrue:[
+            aStream := fileName asFilename readStream.
+            aStream notNil ifTrue:[^ aStream].
+        ].
+    ].
+
+    "/
+    "/ if there is no SourceManager, look in local standard places first
+    "/
+    (mgr := Smalltalk at:#SourceCodeManager) isNil ifTrue:[
+        aStream := self localSourceStream.
+        aStream notNil ifTrue:[^ aStream].
+    ].
+
+    "/
+    "/ nope - ask my class for the source (this also invokes the SCMgr)
+    "/
+    who := self who.
+    who notNil ifTrue:[
+        myClass := who methodClass.
+
+        (package notNil and:[package ~= myClass package]) ifTrue:[
+            mgr notNil ifTrue:[
+                "/ try to get the source using my package information ...
+                sep := package indexOfAny:'/\:'.
+                sep ~~ 0 ifTrue:[
+                    mod := package copyTo:sep - 1.
+                    dir := package copyFrom:sep + 1.
+                    aStream := mgr streamForClass:nil fileName:source revision:nil directory:dir module:mod cache:true.
+                    aStream notNil ifTrue:[^ aStream].
+                ].
+            ].
+        ].
+
+        aStream := myClass sourceStreamFor:source.
+        aStream notNil ifTrue:[^ aStream].
+    ].
+
+    "/
+    "/ nope - look in standard places 
+    "/ (if there is a source-code manager - otherwise, we already did that)
+    "/
+    mgr notNil ifTrue:[
+        aStream := self localSourceStream.
+        aStream notNil ifTrue:[^ aStream].
+    ].
+
+    "/
+    "/ final chance: try current directory
+    "/
+    aStream isNil ifTrue:[
+        aStream := source asFilename readStream.
+        aStream notNil ifTrue:[^ aStream].
+    ].
+
+    (who isNil and:[source notNil]) ifTrue:[
+        "/
+        "/ mhmh - seems to be a method which used to be in some
+        "/ class, but has been overwritten by another or removed.
+        "/ (i.e. it has no containing class anyMore)
+        "/ try to guess the class from the sourceFileName.
+        "/ and retry.
+        "/
+        className := Smalltalk classNameForFile:source.
+        className knownAsSymbol ifTrue:[
+            myClass := Smalltalk at:className asSymbol ifAbsent:nil.
+            myClass notNil ifTrue:[
+                aStream := myClass sourceStreamFor:source.
+                aStream notNil ifTrue:[^ aStream].
+            ]
+        ]
+    ].                
+
+    ^ nil
 ! !
 
 !Method methodsFor:'accessing-visibility'!
@@ -2361,6 +2375,10 @@
 
 !Method::MethodWhoInfo methodsFor:'accessing'!
 
+method
+    ^ myClass compiledMethodAt:mySelector
+!
+
 methodClass
     "return the class which contains the method represented by myself"
 
@@ -2416,6 +2434,6 @@
 !Method class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.174 1999-08-12 08:59:29 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.175 1999-09-02 21:26:53 cg Exp $'
 ! !
 Method initialize!