"

 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'

	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)

    [see also:]

        Workspace EditTextView 

        Parser ByteCodeCompiler

    [author:]

        Claus Gittinger

"

! !

!Workspace class methodsFor:'defaults'!

updateStyleCache

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

    <resource: #style (#codeErrorSelectionForegroundColor

                       #codeErrorSelectionBackgroundColor)>

    DefaultErrorForegroundColor := StyleSheet colorAt:'codeErrorSelectionForegroundColor'.

    DefaultErrorBackgroundColor := StyleSheet colorAt:'codeErrorSelectionBackgroundColor'.

    "Modified: 1.3.1996 / 13:52:04 / cg"

! !

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

open

    "launch a new workspace"

    |scr topView workspace f|

    topView := StandardSystemView 

                label:(self classResources string:'Workspace') 

                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: 27.2.1996 / 17:41:08 / cg"

! !

!Workspace methodsFor:'accessing'!

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.

    ].

    "

     do the abort if we have to

    "

    answer ifFalse:[    

        Object abortSignal raise.

    ].

    ^ false

    "Created: 24.11.1995 / 22:56:34 / 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:'events'!

keyPress:key x:x y:y

    <resource: #keyboard (#DoIt #InspectIt #PrintIt)>

    |cmd commands fKey|

    (key == #DoIt)      ifTrue:[^ self doIt].

    (key == #InspectIt) ifTrue:[^ self inspectIt].

    (key == #PrintIt)   ifTrue:[^ self printIt].

    "

     Ctrl-Fn or Cmd-Fn evaluates a key-sequence (n = 0..99)

     (I added Ctrl-Fn, because some windowmanagers already use cmd-fn)

     see TextView>>keyPress:x:y:

    "

    key isSymbol ifTrue:[

        (key startsWith:'CmdF') ifTrue:[

            fKey := key copyFrom:4 

        ] ifFalse:[

            (key startsWith:'CtrlF') ifTrue:[

               fKey := key copyFrom:5 

            ]

        ].

    ].

    fKey notNil ifTrue:[

        fKey := fKey asSymbol.

        commands := Smalltalk at:#FunctionKeySequences ifAbsent:[nil].

        commands notNil ifTrue:[

            cmd := commands at:fKey ifAbsent:[nil].

            cmd notNil ifTrue:[

                AbortSignal "ErrorSignal" handle:[:ex |

                    self warn:'error occurred in keyboard macro'.

                    ex return.

                ] do:[

                    Parser evaluate:cmd asString

                           receiver:self

                          notifying:nil

                            compile:false.

                ].

                ^ self

            ]

        ]

    ].

    super keyPress:key x:x y:y

    "

     example uses of function keys:

     to set tab-distance to 4-cols,

     select the following:

       self setTab4

     then, press shift-F2 to define the sequence;

     press cmd-F2 to execute it 

     voila: you have set 4-tabs.

     (some window managers (MWM, 4DWM have cmd-Fn redefined; use Ctrl-Fn then).

     to switch back, perform the same procedure with:

        self setTab8

     Within the expression, 'self' is bound to the view. Thus, you can do

     all kinds of fancy things.

     For example:

       if you like a browser to come up on the selection when pressing Cmd-F3:

       select:

        |sel|

        sel := self selection asString withoutSeparators.

        (Smalltalk includesKey:sel asSymbol) ifTrue:[

            (Smalltalk at:sel asSymbol) isClass ifTrue:[

                SystemBrowser browseClass:(Smalltalk at:sel asSymbol)

            ]

        ]

     then, press shift-F3 to define the command.

     press cmd-F3 to execute it (select some classname before).

     (notice: on the Indy, Cmd-F3 is already used by the window manager)

     if you like a file-include command on Cmd-F4:

     select:

        |sel|

        sel := self selection.

        sel notNil ifTrue:[

            sel := sel asString withoutSeparators.

            s := FileStream readonlyFileNamed:sel.

            s notNil ifTrue:[

                self paste:(s contents asString).

                s close

            ]

        ]

    this will paste the contents of the file at the current cusor position.

    (select above expression, press Shift-F4,

     then select any filename and press Cmd-F4)

        try it here: /etc/passwd 

    "

    "Modified: 27.2.1996 / 15:11:09 / cg"

! !

!Workspace methodsFor:'execution'!

doItWithValueDo:aBlock

    "helper for doIt, printIt and inspectIt. 

     Evaluate the selection and, if all went well, evaluate the argument, 

     aBlock with the value.

     Most work is in preparing for proper cleanup in case of abort

     or other exception while the evaluation is performed.

     (restore cursor, selectionColors etc.)"

    |code value selLine selCol endLine endCol cLine cCol cleanUp|

    code := self selection.

    code notNil ifTrue:[

        codeStartPosition := self characterPositionOfSelection.

        "

         remember selection for later - if there is an error,

         the notification method will highlight it.

         thus destroying the current selection

        "

        selLine := selectionStartLine.

        selCol := selectionStartCol.

        endLine := selectionEndLine.

        endCol := selectionEndCol.

        cCol := cursorCol.

        cLine := cursorLine.

        "

         cleanup: restore previous selection and cursor positions

        "

        cleanUp := [

                self selectFromLine:selLine col:selCol toLine:endLine col:endCol.

                cLine notNil ifTrue:[

                    self cursorLine:cLine col:cCol

                ].

        ].

        "

         perform the action.

         Be careful to release the reference to the value;

         otherwise, we could keep lots of garbage from being freed

         until the view gets closed

        "

        self topView withExecuteCursorDo:[

            [

                AbortSignal handle:[:ex |

                     ex return

                ] do:[

                    doItAction notNil ifTrue:[

                        value := doItAction value:code asString.

                        cleanUp value. cleanUp := nil.

                        aBlock value:value.

                    ]

                ]

            ] valueNowOrOnUnwindDo:[

                cleanUp notNil ifTrue:[cleanUp value. cleanUp := nil].

                value := nil

            ]

        ].

    ]

    "Modified: 27.2.1996 / 15:30:58 / cg"

! !

!Workspace methodsFor:'initialize / release'!

initStyle

    super initStyle.

    errorFgColor := DefaultErrorForegroundColor.

    errorFgColor isNil ifTrue:[errorFgColor := selectionFgColor].

    errorBgColor := DefaultErrorBackgroundColor.

    errorBgColor isNil ifTrue:[

	device hasColors ifTrue:[

	    errorBgColor := Color red

	] ifFalse:[

	    errorBgColor := selectionBgColor

	]

    ].

!

initialize

    super initialize.

    showMatchingParenthesis := true.

    self initializeDoITAction.

!

initializeDoITAction

    "set up the block to be evaluated for doIts.

     This is done here in a separate method to allow easier

     redefinition in subclasses"