"

 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.

"

TextCollector subclass:#Workspace

	instanceVariableNames:'doItAction codeStartPosition errorFgColor errorBgColor

		commentStrings'

	classVariableNames:'DefaultErrorForegroundColor DefaultErrorBackgroundColor'

	poolDictionaries:''

	category:'Interface-Workspace'

!

!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')>

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

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

    "Modified: 20.10.1997 / 14:06:18 / cg"

! !

!Workspace class methodsFor:'getting a System 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"

! !

!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 methodsFor:'accessing'!

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

!

doItAction:aOneArgBlock

    "define the action to be performed when 'doIt' is selected.

     The block will be evaluated, passing the selection as a String argument. 

     A default doItAction is set for you in the initialize method."

    doItAction := aOneArgBlock

    "Modified: 27.2.1996 / 15:31:37 / cg"

! !

!Workspace methodsFor:'compiler interface'!

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:'Error'

                      form:(WarningBox iconBitmap)

                      buttonLabels:#('cancel' 'correct' 'continue')

                      values:#(#abort #correct #continue)

                      default:#continue.

    ].

    action == #abort ifTrue:[

        Object abortSignal raise.

        ^ false

    ].

    ^ action == #correct

    "Modified: 20.2.1996 / 20:48:52 / cg"

!

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

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

     and show a Box asking for continue/abort."

    |answer|

    self highlightingErrorPosition:relPos to:relEndPos do:[

        |box lbl|

        WarningSignal isHandled ifTrue:[

            WarningSignal raiseErrorString:aString.

            ^ false

        ].

        "

         ask if we should abort or continue

        "

        box := YesNoBox title:aString

                      yesText:(resources string:'continue')

                       noText:(resources string:'abort').

        asWarning ifTrue:[

            lbl := 'Compiler warning'

        ] ifFalse:[

            lbl := 'Compiler error'.

        ].

        box label:lbl.

        box form:(WarningBox iconBitmap).

        answer := box confirm.  

        box destroy.

    ].

    "

     do the abort if we have to

    "

    answer ifFalse:[    

        Object abortSignal raise.

    ].

    ^ false

    "Created: 24.11.1995 / 22:56:34 / cg"

    "Modified: 7.1.1997 / 23:00:45 / cg"

!

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 asWarning:false

!

highlightingErrorPosition:relPos to:relEndPos do:aBlock

    "evaluate aBlock while some selection is shown highlighted with error colors."

    |absPosition fg bg|

    "

     change color of selection & hide cursor

    "

    fg := selectionFgColor.

    bg := selectionBgColor.

    selectionBgColor := errorBgColor.

    selectionFgColor := errorFgColor.

    self hideCursor.

    "

     select the text - relEndPos may be nil in which case the whole line is selected

     we have to adjust the positions given by the compiler, since they

     are relative to the texts start (the compiler did stream-read the code).

    "

    codeStartPosition isNil ifTrue:[codeStartPosition := 1].

    absPosition := codeStartPosition + relPos - 1.

    relEndPos isNil ifTrue:[

	self selectLineWhereCharacterPosition:absPosition

    ] ifFalse:[

	self selectFromCharacterPosition:absPosition to:(codeStartPosition + relEndPos - 1)

    ].

    self makeSelectionVisible.

    device flush.

    aBlock valueNowOrOnUnwindDo:[

	"

	 undo selection color change and show cursor again

	"

	selectionFgColor := fg.

	selectionBgColor := bg.

	self showCursor.

    ].

!

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

    "compiler notifies us of a warning - same behavior as error"

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

! !

!Workspace methodsFor:'editing'!

commentFrom:line1 to:line2

    "convenient function to comment out a block.

     All lines from line1 to line2 get an end-of-line comment

     in the first col."

    |eolComment opening closing|

    eolComment := commentStrings at:1.

    eolComment isNil ifTrue:[

        opening := (commentStrings at:2) at:1.

        closing := (commentStrings at:2) at:2.

        (opening isNil or:[closing isNil]) ifTrue:[^ self].

    ].

    line1 to:line2 do:[:lineNr |

        |l|

        l := self listAt:lineNr.

        l isNil ifTrue:[l := ''].

        eolComment notNil ifTrue:[

            l := eolComment , l

        ] ifFalse:[

            l := opening , l , closing

        ].

        self at:lineNr put:l

    ].

    self textChanged.

    "Modified: / 7.1.1997 / 20:15:06 / cg"

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

!

commentSelection

    "convenient function to comment out a block.

     All lines from line1 to line2 get an end-of-line comment

     in the first col."

    |e commentPair opening closing|

    (self checkModificationsAllowed) ifFalse:[ ^ self].

    selectionStartLine notNil ifTrue:[

        (selectionStartCol == 1 and:[selectionEndCol == 0]) ifTrue:[

            self commentFrom:selectionStartLine to:selectionEndLine-1

        ] ifFalse:[

            commentPair := commentStrings at:2.

            opening := commentPair at:1.

            closing := commentPair at:2.

            (opening isNil or:[closing isNil]) ifTrue:[^ self].

            e := selectionEndCol.

            self insertString:closing atLine:selectionEndLine col:e+1.

            self insertString:opening atLine:selectionStartLine col:selectionStartCol.

            selectionStartLine == selectionEndLine ifTrue:[e := e + opening size].

            self selectFromLine:selectionStartLine col:selectionStartCol

                         toLine:selectionEndLine col:e+closing size.

        ]

    ]

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

    "Modified: / 5.4.1998 / 16:52:23 / cg"

!

uncommentFrom:line1 to:line2

    "convenient function to comment out a block.

     All lines from line1 to line2 get an end-of-line comment

     in the first col."

    |eolComment opening closing rest|

    eolComment := commentStrings at:1.

    eolComment isNil ifTrue:[

        opening := (commentStrings at:2) at:1.

        closing := (commentStrings at:2) at:2.

        (opening isNil or:[closing isNil]) ifTrue:[^ self].

    ] ifFalse:[

        rest := eolComment size + 1.

    ].

    line1 to:line2 do:[:lineNr |

        |l|

        l := self listAt:lineNr.

        l notNil ifTrue:[

            eolComment notNil ifTrue:[

                (l startsWith:eolComment) ifTrue:[

                    l := l copyFrom:rest

                ]

            ] ifFalse:[

                ((l startsWith:opening)

                and:[l endsWith:closing]) ifTrue:[

                    l := l copyFrom:opening size + 1.

                    l := l copyWithoutLast:closing size.

                ]

            ].

            self at:lineNr put:l

        ]

    ].

    self textChanged.

    "Modified: / 7.1.1997 / 20:17:44 / cg"

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

!

uncommentSelection

    "convenient function to comment out a block.

     All lines from line1 to line2 get an end-of-line comment

     in the first col."

    |e commentPair opening closing sz1 sz2|

    selectionStartLine notNil ifTrue:[

        (selectionStartCol == 1 and:[selectionEndCol == 0]) ifTrue:[

            self uncommentFrom:selectionStartLine to:selectionEndLine-1

        ] ifFalse:[

            commentPair := commentStrings at:2.

            opening := commentPair at:1.

            closing := commentPair at:2.

            (opening isNil or:[closing isNil]) ifTrue:[^ self].

            sz1 := opening size.

            sz2 := closing size.

            ((self 

                stringAtLine:selectionStartLine 

                from:selectionStartCol

                to:selectionStartCol+sz1 - 1) = opening

            and:[(self