"

 COPYRIGHT (c) 1989 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.

"

"{ Package: 'stx:libwidg' }"

TextCollector subclass:#Workspace

	instanceVariableNames:'doItAction codeStartPosition errorFgColor errorBgColor

		commentStrings autoDefineWorkspaceVariables simulatedSelf

		autoDefineVariables compilerClass'

	classVariableNames:'DefaultViewBackground DefaultErrorForegroundColor

		DefaultErrorBackgroundColor DefaultWarningBackgroundColor

		DefaultWarningForegroundColor WorkspaceVariables DoItHistory'

	poolDictionaries:''

	category:'Interface-Smalltalk'

!

!Workspace class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 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 view for editable text which can evaluate expressions.

    I.e. its basically a view for editable text, with added

    'doIt', 'printIt' and 'inspectIt' functions on the popup-menu.

    The action to be performed on doIt is defined by a block,

    which can be defined by the owner of this view.

    (thus you can put a workspace into more complex widgets, and

     control what should happen on 'doIt').

    A useful default action is automatically defined, which simply 

    evaluates the selection as a smalltalk expression. 

    (but, a lisp or prolog workspace would define its own action,

     to call for another compiler/interpreter  ...)

    Caveat:

        in this version, Workspace does not yet support doIt in MVC setups.

        For now, simulate this by setting the doItAction, to notify the

        model manually about the doIt.

    [instance variables:]

      doItAction      <Block>         block to evaluate for doIt

      errorFgColor    <Color>         fg-Color to be used when highlighting errors 

      errorBgColor    <Color>         bg-Color to be used when highlighting errors

      codeStartPosition               private temporary

    [styleSheet values:]

      codeErrorSelectionForegroundColor     fg color to highlight errors

                                            (default: selection fg)

      codeErrorSelectionBackgroundColor     bg color to highlight errors

                                            (default: selection bg)

    [start with:]

        Workspace open

    [see also:]

        Workspace EditTextView 

        Parser ByteCodeCompiler

    [author:]

        Claus Gittinger

"

! !

!Workspace class methodsFor:'defaults'!

defaultLabel

    "my default window label"

    ^ 'Workspace'

    "Created: / 16.5.1998 / 16:53:37 / cg"

!

updateStyleCache

    "extract values from the styleSheet and cache them in class variables"

    <resource: #style (#'codeErrorSelection.foregroundColor'

                       #'codeErrorSelection.backgroundColor'

                       #'codeView.backgroundColor' )>

    DefaultErrorForegroundColor := StyleSheet colorAt:'codeErrorSelection.foregroundColor'.

    DefaultErrorBackgroundColor := StyleSheet colorAt:'codeErrorSelection.backgroundColor'.

    DefaultViewBackground := StyleSheet colorAt:'codeView.backgroundColor'.

! !

!Workspace class methodsFor:'getting a new Workspace'!

open

    "launch a new workspace"

    |scr topView workspace f|

    topView := StandardSystemView 

                label:(self classResources string:(self defaultLabel)) 

                " minExtent:(100 @ 100)".

    scr := HVScrollableView for:self in:topView.

    scr origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).

    workspace := scr scrolledView.

    "/ adjust topViews extent according to my font

    f := workspace font.

    topView extent:((f widthOf:'x') * 40) @ (f height * 10).

    topView open.

    ^ workspace

    "

     Workspace open

    "

    "Modified: / 16.5.1998 / 16:53:53 / cg"

!

openForRemote:hostName

    "launch a new workspace to evaluate expression on some remote machine.

     Entered expressions are sent over to some partner machine, evaluated there,

     and the result is shown here.

     This requires the RemoteObjects package to be loaded."

    |server remoteCompiler workspace|

    RemoteObjectServer isNil ifTrue:[

        self warn:'no remoteObjectServer available'.

        ^ nil

    ].

    server := RemoteObjectServer on:hostName.

    remoteCompiler := server get:#Compiler.

    workspace := self open.

    workspace topView 

        label:(self classResources string:'Remote Workspace {%1}' with:hostName).

    workspace doItAction:

                [:theCode |

                    remoteCompiler 

                        evaluate:theCode 

                        in:nil 

                        receiver:nil 

                        notifying:workspace 

                        logged:true 

                        ifFail:nil 

                ]

    "

     Workspace openForRemote:'andi'

    "

    "Modified: / 16.5.1998 / 16:57:38 / cg"

!

openWith:initialText selected:selectedBoolean

    "launch a new workspace with some initial contents"

    |workspace|

    workspace := self open.

    workspace contents:initialText selected:selectedBoolean.

    ^ workspace

    "

     Workspace openWith:'Transcript showCR:''hello world'''

    "

! !

!Workspace class methodsFor:'history'!

clearDoItHistory

    DoItHistory := nil

!

doItHistory

    ^ DoItHistory

!

doItHistorySize

    "the number of remembered doIts"

    ^ 20

!

rememberDoIt:aString

    |string|

    string := aString asString string withoutSeparators.

    (string asCollectionOfWords size <= 1) ifTrue:[

        ((Scanner new scanTokens:string) size <= 1) ifTrue:[

            "its a variable only"

            ^ self

        ]

    ].

    DoItHistory isNil ifTrue:[

        DoItHistory := OrderedCollection new.

    ].

    DoItHistory remove:string ifAbsent:nil.

    DoItHistory addFirst:string.

    DoItHistory size > self doItHistorySize ifTrue:[

        DoItHistory removeLast

    ].

    Scanner

! !

!Workspace class methodsFor:'queries'!

isVisualStartable

    "returns whether this application class can be started via #open

     (i.e. via a double click on the class in the browser)"

    ^ self == Workspace

    "Created: / 16.5.1998 / 16:59:00 / cg"

    "Modified: / 16.5.1998 / 16:59:39 / cg"

! !

!Workspace class methodsFor:'workspace variables'!

addWorkspaceVariable:name

    "create a new workspace variable"

    |holder|

    WorkspaceVariables isNil ifTrue:[

        WorkspaceVariables := Dictionary new.

    ].

    holder := WorkspaceVariables at:name ifAbsentPut:[ ValueHolder new ].

    ^ holder

!

removeAllWorkspaceVariables

    "delete all workspace variables"

    WorkspaceVariables := nil

!

removeWorkspaceVariable:name

    "delete a workspace variable"

    WorkspaceVariables notNil ifTrue:[

        WorkspaceVariables removeKey:name ifAbsent:nil.

        WorkspaceVariables isEmpty ifTrue:[

            WorkspaceVariables := nil

        ]

    ].

!

workspaceVariableAt:name

    "retrieve a workspace variable (actually, a holder onto it)"

    WorkspaceVariables isNil ifTrue:[^ nil].

    ^ WorkspaceVariables at:name ifAbsent:nil.

!

workspaceVariables

    "retrieve the collection of workspace variables"

    ^ WorkspaceVariables

! !

!Workspace methodsFor:'accessing'!

autoDefineVariables

    ^ autoDefineVariables 

!

autoDefineVariables:nilOrSymbol

    autoDefineVariables := nilOrSymbol.

!

commentStrings:anArrayOfCommentStrings

    "define the comment strings"

    commentStrings := anArrayOfCommentStrings

    "Created: / 9.11.1997 / 01:05:25 / cg"

!

doItAction

    "return the action to be performed when 'doIt' is selected"

    ^ doItAction

!

errorBackgroundColor

    errorBgColor notNil ifTrue:[ ^ errorBgColor ].

    DefaultErrorBackgroundColor notNil ifTrue:[ ^ DefaultErrorBackgroundColor ].

    device hasColors ifTrue:[ ^ Color red ].

    ^ selectionBgColor

!

errorForegroundColor

    errorFgColor notNil ifTrue:[ ^ errorFgColor ].

    DefaultErrorForegroundColor notNil ifTrue:[ ^ DefaultErrorForegroundColor ].

    ^ selectionFgColor

!

selectAll

    super selectAll

!

simulatedSelf:anObject

    "define what self is in an evaluation"

    simulatedSelf := anObject

!

warningBackgroundColor

    DefaultWarningBackgroundColor notNil ifTrue:[ ^ DefaultWarningBackgroundColor ].

    device hasColors ifTrue:[ ^ Color orange ].

    ^ selectionBgColor

!

warningForegroundColor

    DefaultWarningForegroundColor notNil ifTrue:[ ^ DefaultWarningForegroundColor ].

    ^ selectionFgColor

! !

!Workspace methodsFor:'compiler interface'!

compilerClass

    ^ compilerClass ? Compiler

!

compilerClass:aCompilerClass

    compilerClass := aCompilerClass

!

currentSourceCode

    "special interface to compiler - called by parser

     to get the updated source code after a corrected error"

    ^ self contents

!

wantChangeLog

    "sent by the compiler to ask if a changeLog entry should

     be written. Return true here."

    ^ true

! !

!Workspace methodsFor:'compiler interface-error handling'!

correctableError:aString position:relPos to:relEndPos from:aCompiler

    "compiler notifies us of a correctable error;

     hilight the error (relPos to relEndPos) and show a Box asking for continue/correct/abort;

     this method should return true to the compiler if user wants the error

     to be corrected; false otherwise"

    |action|

    self highlightingErrorPosition:relPos to:relEndPos do:[

        action := OptionBox 

                      request:aString

                      label:'Correctable Error'

                      image:(WarningBox iconBitmap)

                      buttonLabels:#('Cancel' 'Declare as...' 'Correct...' 'Continue')

                      values:#(#abort #declare #correct #continue)

                      default:#continue

                      onCancel:#abort.

    ].

    action == #declare ifTrue:[

        ^ action

    ].

    action == #abort ifTrue:[

        AbortOperationRequest raise.

        ^ false

    ].

    ^ action == #correct

    "Modified: / 16.11.2001 / 17:39:26 / cg"

!

correctableSelectorWarning:aString position:relPos to:relEndPos from:aCompiler

    "compiler notifies us of a correctable selector warning;

     hilight the error (relPos to relEndPos) and show a Box asking for continue/correct/abort;

     this method should return true to the compiler if user wants the error

     to be corrected; false otherwise"

    |action|

    self highlightingErrorPosition:relPos to:relEndPos do:[

        action := OptionBox 

                      request:aString

                      label:'Warning'

                      image:(WarningBox iconBitmap)

                      buttonLabels:(resources array:#('Cancel' 'Correct...' 'Generate' 'Continue'))

                      values:#(#abort #correct #generate #continue)

                      default:#continue

                      onCancel:#abort.

    ].

    action == #generate ifTrue:[

        ^ action

    ].

    (action isNil or:[action == #abort]) ifTrue:[

        AbortOperationRequest raise.

        ^ false

    ].

    ^ action == #correct

    "Created: / 19.1.2000 / 16:27:28 / cg"

    "Modified: / 16.11.2001 / 17:39:29 / cg"

!

error:aString position:relPos to:relEndPos asWarning:asWarning

    "obsolete - no longer invoked"

    ^ self error:aString position:relPos to:relEndPos from:nil asWarning:asWarning

!

error:aString position:relPos to:relEndPos from:aCompiler

    "compiler notifies us of an error; hilight the error (relPos to relEndPos) 

     and show a Box asking for continue/abort."

    ^ self error:aString position:relPos to:relEndPos from:aCompiler asWarning:false

!

error:aString position:relPos to:relEndPos from:aCompiler asWarning:asWarning

    "compiler notifies us of an error; hilight the error (relPos to relEndPos) 

     and show a Box asking for continue/abort."

    |answer fg bg|

    fg := asWarning ifTrue:[ self warningForegroundColor ] ifFalse:[ self errorForegroundColor ].

    bg := asWarning ifTrue:[ self warningBackgroundColor ] ifFalse:[ self errorBackgroundColor ].

    self 

        highlightingErrorPosition:relPos to:relEndPos 

        withForeground:fg andBackground:bg

        do:[

            |box lbl doNotShowAgainHolder l1 y1 y2 l2|

            WarningSignal isHandled ifTrue:[

                WarningSignal raiseErrorString:aString.

                ^ false

            ].

            "