"
 COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Parser subclass:#Explainer
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'System-Compiler'
!

!Explainer class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    a very simple explainer - much more should be added ...
    This one is involved, when the 'explain' function is used in a 
    codeView (popup or via CMD-E).

    [author:]
        Claus Gittinger
"
! !

!Explainer class methodsFor:'explaining'!

commonSuperClassOf:listOfClassNames
    |common found|

    listOfClassNames do:[:className |
        |class|

        class := Smalltalk classNamed:className.
        common isNil ifTrue:[
            common := class
        ] ifFalse:[
            (class isSubclassOf:common) ifTrue:[
                "keep common"
            ] ifFalse:[
                (common isSubclassOf:class) ifTrue:[
                    common := class
                ] ifFalse:[
                    "walk up, checking"
                    found := false.
                    common allSuperclassesDo:[:sup |
                        (class isSubclassOf:sup) ifTrue:[
                            common := sup
                        ]
                    ].
                    found ifFalse:[
                        class allSuperclassesDo:[:sup |
                            (common isSubclassOf:sup) ifTrue:[
                                common := sup
                            ]
                        ].
                    ].
                ]
            ].
        ].
        common == Object ifTrue:[^ common]
    ].
    ^ common

    "Modified: 17.6.1996 / 17:09:21 / stefan"
    "Modified: 5.9.1996 / 19:34:41 / cg"
!

explain:someText in:source forClass:aClass
    "Given a source and a substring of it, return a string containing
     an explanation.
     This is just a q&d implementation - to be correct, it should use the parser,
     and explain from the parsetree (instead of doing string matches).
     This leads to some wrong explanations, for example if some string is
     used as selector within a string, or if a variable is named like a
     message selector. I.e. the explanation should be context sensitive.
     Also, there could be much more detailed explanations."

    |parser variables v c string tmp
     spc sym sel stringText|

    string := someText string withoutSeparators.
    stringText := string asText allBold.

    "
     ask parser for variable names
    "
    parser := self parseMethod:source in:aClass ignoreErrors:true ignoreWarnings:true.
    parser notNil ifTrue:[
        "look for variables"

        variables := parser methodVars.
        (variables notNil and:[variables includes:string]) ifTrue:[
            ^ '''' , stringText , ''' is a method variable'
        ].
        variables := parser methodArgs.
        (variables notNil and:[variables includes:string]) ifTrue:[
            ^ '''' , stringText , ''' is a method argument'
        ]
    ].

    parser isNil ifTrue:[
        parser := self for:(ReadStream on:source) in:aClass
    ].

    "instvars"
    c := aClass whichClassDefinesInstVar:string.
    c notNil ifTrue:[
        c isMeta ifTrue:[
            ^ '''' , stringText , ''' is a class instance variable in ' , c soleInstance name
        ].

        ^ '''' , stringText , ''' is an instance variable in ' , c name
    ].

"/    variables := aClass allInstVarNames.
"/    (variables notNil and:[variables includes:string]) ifTrue:[
"/        "where is it"
"/        c := aClass.
"/        [c notNil] whileTrue:[
"/            v := c instVarNames.
"/            (v notNil and:[v includes:string]) ifTrue:[
"/                ^ string , ' is an instance variable in ' , c name
"/            ].
"/            c := c superclass
"/        ].
"/        self error:'oops'
"/    ].

"/    "class instvars"
"/    variables := aClass class allInstVarNames.
"/    (variables notNil and:[variables includes:string]) ifTrue:[
"/        "where is it"
"/        c := aClass.
"/        [c notNil] whileTrue:[
"/            v := c class instVarNames.
"/            (v notNil and:[v includes:string]) ifTrue:[
"/                ^ string , ' is a class instance variable in ' , c name
"/            ].
"/            c := c superclass
"/        ].
"/        self error:'oops'
"/    ].

    "classvars"
    c := parser inWhichClassIsClassVar:string.
    c notNil ifTrue:[
        ^ '''' , stringText , ''' is a class variable in ' , c name
    ].

    aClass isMeta ifTrue:[
        c := aClass soleInstance.
    ] ifFalse:[
        c := aClass.
    ].
    c privateClasses do:[:pClass |
        (pClass name = string 
         or:[pClass nameWithoutPrefix = string]) ifTrue:[
            ^ ('''' , stringText , ''' is a private class in ''' , c name , '''.'
                     , '\\It is only visible locally.') withCRs
        ].
    ].

    (spc := aClass nameSpace) notNil ifTrue:[
        sym := (spc name , '::' , string) asSymbolIfInterned.
        sym notNil ifTrue:[
            (Smalltalk at:sym) isBehavior ifTrue:[
                ^ ('''' , stringText , ''' is a class in the ''' , spc name , ''' nameSpace.'
                         , '\\It is only visible within this nameSpace.'
                         , '\Access from the outside is possible'
                         , '\by the special name ''' , spc name , '::' , string , '''.') withCRs
            ].
        ].
    ].

"/    string knownAsSymbol ifTrue:[
        "globals & symbols"

        tmp := self explainKnownSymbol:string inClass:aClass.
        tmp notNil ifTrue:[ ^ tmp].

        "/ try with added colon ...
        sel := string , ':'.
        Symbol allInstancesDo:[:sym |
            (sym startsWith:sel) ifTrue:[
                tmp := self explainKnownSymbol:sym inClass:aClass.
                tmp notNil ifTrue:[ ^ tmp].
            ]
        ].
"/    ].

    "try for some obvious things"
    tmp := self explainPseudoVariable:string in:aClass.
    tmp notNil ifTrue:[ ^ tmp].

    "try syntax ..."

    tmp := self explainSyntax:string.
    tmp notNil ifTrue:[ ^ tmp].

    parser isNil ifTrue:[
        ^ 'parse error - no explanation'
    ].
    ^ 'cannot explain this (could not figure out what this is).'

    "Created: / 3.12.1995 / 12:47:37 / cg"
    "Modified: / 16.4.1997 / 12:46:11 / stefan"
    "Modified: / 23.3.1999 / 13:29:56 / cg"
!

explainHereIn:aClass
    ^ 'like self, here refers to the object which received the message.

However, when sending a message to here the search for methods
implementing this message will start in the defining class (' , aClass name , ')
instead of the receivers class (' , aClass name , ' or subclass).
Thus, using here, redefined methods will NOT be reached with a here-send.'
!

explainKnownSymbol:string inClass:aClass
    "return explanation or nil"

    |sym list count tmp commonSuperClass val s s2 
     firstImplementingClass cm msg|

    sym := string asSymbolIfInterned.
    sym isNil ifTrue:[^ nil].

    "try globals"

    (Smalltalk includesKey:sym) ifTrue:[
        tmp := '''' , string asText allBold , ''' is a global variable.'.
        val := Smalltalk at:sym.
        val isBehavior ifTrue:[
            val name = string ifTrue:[
                tmp := tmp , '

' , string , ' is ' , (val isLoaded ifTrue:['a'] ifFalse:['an autoloaded'])
, ' class categorized as ' , val category , '
in the ''' , val package , ''' package.'
            ] ifFalse:[
                tmp := tmp , '

' , string , ' is bound to the class ' , val name ,
' in category ' , val category , '.'
            ]
        ] ifFalse:[
            tmp := tmp , '

Its current value is ' , val classNameWithArticle , '.'
        ].
        ^ tmp.
    ].

    "
     try selectors
     look who implements it
    "
    list := Set new.
    Smalltalk allBehaviorsDo:[:c|
        (c implements:sym) ifTrue:[
            list add:(c name).
            firstImplementingClass isNil ifTrue:[
                firstImplementingClass := c
            ]
        ].
        (c class implements:sym) ifTrue:[
            list add:(c name , ' class').
            firstImplementingClass isNil ifTrue:[
                firstImplementingClass := c class
            ]
        ]
    ].

    (aClass canUnderstand:sym) ifTrue:[
        s2 := ('\\Instances of ''' , aClass name , ''' respond to #') withCRs , sym asText allBold
              , '\- inherited from ' withCRs, (aClass whichClassImplements:sym) name asText allBold.

        firstImplementingClass := (aClass whichClassImplements:sym)
    ] ifFalse:[
        s2 := ''.
    ].

    count := list size.
    (count ~~ 0) ifTrue:[
        "
         for up-to 4 implementing classes,
         list them
        "
        list := list asOrderedCollection sort.
        tmp := ' is a selector implemented in '.
        s := '#' , string asText allBold.

        (count == 1) ifTrue:[
            msg := s , tmp , (list at:1) , '.' , s2.
        ] ifFalse:[
            (count == 2) ifTrue:[
                msg := s , tmp , (list at:1) , ' and ' , (list at:2) , '.' , s2
            ] ifFalse:[
                (count == 3) ifTrue:[
                    msg := s , tmp , '
' , (list at:1) , ', ' , (list at:2) , ' and ' , (list at:3) , '.' , s2
                ] ifFalse:[
                    (count == 4) ifTrue:[
                        msg := s , tmp , '
' , (list at:1) , ', ' , (list at:2) , ', ' , (list at:3), ' and ' , (list at:4) , '.' , s2
                    ] ifFalse:[
                        "
                         if there are more, look for a common
                         superclass and show it ...
                        "
                        commonSuperClass := self commonSuperClassOf:list.
                        (commonSuperClass ~~ Object 
                        and:[commonSuperClass ~~ Behavior
                        and:[commonSuperClass ~~ Class
                        and:[commonSuperClass ~~ ClassDescription]]]) ifTrue:[
                            (list includes:commonSuperClass) ifTrue:[
                                msg := s . tmp , count printString , commonSuperClass name 
                                         , ' and redefined in ' , (count - 1) printString  
                                         , ' subclasses'
                                         , s2.
                                firstImplementingClass := commonSuperClass
                            ] ifFalse:[
                                msg := s , tmp, count printString , ' subclasses of ' , commonSuperClass name , s2
                            ]
                        ] ifFalse:[
                            (commonSuperClass == Object
                            and:[commonSuperClass implements:sym]) ifTrue:[
                                msg := s , tmp , count printString , ' classes.

All objects seem to respond to that message, 
since there is an implementation in Object.' , s2.

                                firstImplementingClass := Object
                            ] ifFalse:[
                                ((commonSuperClass == Behavior
                                 or:[commonSuperClass == Class
                                 or:[commonSuperClass == ClassDescription]])
                                and:[commonSuperClass implements:sym]) ifTrue:[
                                    msg := s , tmp , count printString , ' classes.

All classes seem to respond to that message, 
since there is an implementation in ' , commonSuperClass name , '.' , s2.

                                    firstImplementingClass := commonSuperClass
                                ] ifFalse:[
                                    "
                                     otherwise just give the number.
                                    "
                                    msg := s , tmp , count printString , ' classes.' , s2
                                ]
                            ]
                        ]
                    ]
                ]
            ].
        ].
        firstImplementingClass notNil ifTrue:[
            WindowGroup activeGroup withWaitCursorDo:[
                cm := firstImplementingClass compiledMethodAt:sym.
                cm notNil ifTrue:[
                    cm := cm methodComment.
                ]
            ].
            cm notNil ifTrue:[
                msg := msg , '\\The comment in ' withCRs , firstImplementingClass name asText allBold , ' is:\' withCRs , cm asText allItalic.
            ]
        ].
        ^ msg
    ].

    ^ nil

    "Modified: / 17.6.1996 / 17:09:30 / stefan"
    "Created: / 23.3.1999 / 13:29:33 / cg"
    "Modified: / 23.3.1999 / 13:40:40 / cg"
!

explainPseudoVariable:string in:aClass
    "return explanation for the pseudoVariables self, super etc."

    (string = 'self') ifTrue:[
	^ self explainSelfIn:aClass
    ].

    (string = 'super') ifTrue:[
	^ self explainSuperIn:aClass
    ].

    (string = 'here') ifTrue:[
	^ self explainHereIn:aClass
    ].

    (string = 'thisContext') ifTrue:[
	^ 'thisContext is a pseudo variable (i.e. it is built in).

ThisContext always refers to the context object for the currently executed method or
block (an instance of Context or BlockContext respectively). The calling chain and calling
receivers/selectors can be accessed via thisContext.'
    ].

    (string = 'true') ifTrue:[
	^ 'true is a pseudo variable (i.e. it is built in).

True represents logical truth. It is the one and only instance of class True.'
    ].

    (string = 'false') ifTrue:[
	^ 'false is a pseudo variable (i.e. it is built in).

False represents logical falseness. It is the one and only instance of class False.'
    ].

    (string = 'nil') ifTrue:[
	^ 'nil is a pseudo variable (i.e. it is built in).

Nil is used for unitialized variables (among other uses).
Nil is the one and only instance of class UndefinedObject.'
    ].
    ^ nil
!

explainSelfIn:aClass
    |sub|

    sub := aClass allSubclasses collect:[:c | c name].
    sub size == 0 ifTrue:[
	^ 'self refers to the object which received the message.

In this case, it will be an instance of ' , aClass name , '.'
    ].

    sub size <= 5 ifTrue:[
	^ 'self refers to the object which received the message.

In this case, it will be an instance of ' , aClass name , '
or one of its subclasses:

' , sub asStringCollection asString
    ].

    ^ 'self refers to the object which received the message.

In this case, it will be an instance of ' , aClass name , '
or one of its ' , sub size printString , ' subclasses.'
!

explainSuperIn:aClass
    ^ 'like self, super refers to the object which received the message.

However, when sending a message to super the search for methods
implementing this message will start in the superclass (' , aClass superclass name , ')
instead of the receivers class (' , aClass name , ' or subclass).
Thus, using super, a redefined method can call the original method in its superclass.'
!

explainSyntax:string
    "try syntax ...; return explanation or nil"

    ((string = ':=') or:[string = '_']) ifTrue:[
        ^ '<variable> := <expression>

'':='' and ''_'' (which is left-arrow in some fonts) mean assignment.
The variable is bound to (i.e. points to) the value of <expression>.'
    ].

    (string = '^') ifTrue:[
        ^ '^ <expression>

returns the value of <expression> as value from the method.
A return from within a block exits the method where the block is defined.'
    ].

    (string = ';') ifTrue:[
        ^ '<expression> ; selector1 ; .... ; selectorN

a cascade expression; evaluate expression, and send messages 
<selector1> ... <selectorN> to the first expressions receiver. 
Returns the value of the last send. The cascade sends may also have arguments.'
    ].

    (string = '|') ifTrue:[
        ^ '| locals |  or: [:arg | statements]

''|'' is used to mark a local variable declaration or separates arguments
from the statements in a block. Notice, that in a block-argument declaration
these must be prefixed by a colon character.
''|'' is also a selector understood by Booleans.'
    ].

    ((string startsWith:'(') or:[string endsWith:')']) ifTrue:[
        ^ '(<expression>)

expression grouping.'
    ].

    ((string startsWith:'[') or:[string endsWith:']']) ifTrue:[
        ^ '[:arg1 .. :argN | statements]

defines a block. 
Blocks represent pieces of executable code. Definition of a block does
not evaluate it. The block is evaluated by sending it a value/value:
message.
Blocks are often passed as arguments to Booleans (i.e. ifTrue:[...]) or
collections (i.e. do:[...]).'
    ].

    (string = ':') ifTrue:[
        ^ 'colons have different meaning depending on context:

1) they separate keyword-parts in symbols and keyword-messages as in:

    #at:put:                     a constant keyword symbol

    rec at:index put:value       sends the #at:put: message to rec,
                                 passing index and value as arguments.

2) within block-argument declarations as in:

    [:arg1 :arg2 | statements]

3) within an identifier, they separate the nameSpace part from
   the name part; as in:

    Smalltalk::Array    - the Array class in the Smalltalk nameSpace.
    Foo::Array          - the Array class in the Foo nameSpace.
'
    ].

    (string = '.') ifTrue:[
        ^ 'statement. "<- period here"
statement

within a method or block, individual statements are separated by periods.
'
    ].

    (string startsWith:'#' ) ifTrue:[
        (string startsWith:'#(' ) ifTrue:[
            ^ 'is a constant Array.

The elements of a constant Array must be Number-constants, nil, true or false.
(notice, that not all Smalltalk implementations allow true, false and nil as
 constant-Array elements).'
        ].

        (string startsWith:'#[') ifTrue:[
            ^ 'is a constant ByteArray.

The elements of a constant ByteArray must be Integer constants in the range
0 .. 255.
(notice, that not all Smalltalk implementations support constant ByteArrays).'
        ].

        (string startsWith:'#''') ifTrue:[
            ^ 'is a constant symbol containing non-alphanumeric characters.

Symbols are unique strings, meaning that there exists
exactly one instance of a given symbol. Therefore symbols can
be compared using == (identity compare) in addition to = (contents compare).
Beside this, Symbols behave mostly like Strings.

Notice, that not all Smalltalk implementations support this kind of symbols.'
        ].

        ^ 'is a symbol.

Symbols are unique strings, meaning that there exists
exactly one instance of a given symbol. Therefore symbols can
be compared using == (identity compare) in addition to = (contents compare).
Beside this, Symbols behave mostly like Strings.'
    ].

    "/ is it a symbol without hash-character ?
    "/
"/    string knownAsSymbol ifTrue:[
"/        ^ 'is nothing, but #' , string , ' is known as a symbol.
"/
"/Symbols are unique strings, meaning that there exists
"/exactly one instance of a given symbol. Therefore symbols can
"/be compared using == (identity compare) in addition to = (contents compare).
"/Beside this, Symbols behave mostly like Strings.'
"/    ].

    ^ nil

    "Modified: / 31.10.1998 / 14:28:58 / cg"
! !

!Explainer class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libcomp/Explainer.st,v 1.35 1999-07-15 16:34:38 cg Exp $'
! !