WorkspaceApplication.st
author Stefan Vogel <sv@exept.de>
Thu, 11 Jan 2007 19:05:31 +0100
changeset 7577 9769c6225ff7
parent 7544 a98f0b4a43dd
child 7612 42b1c57c6cc7
permissions -rw-r--r--
Rename nt.mak to bc.mak

"
 COPYRIGHT (c) 2001 by eXept Software AG
              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:libtool' }"

MultiViewToolApplication subclass:#WorkspaceApplication
	instanceVariableNames:'autoDefineVariables syntaxHolder'
	classVariableNames:'LastFilterBlockString LastProcessingBlockString LastTeaWaitTime'
	poolDictionaries:''
	category:'Interface-Smalltalk'
!

!WorkspaceApplication class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2001 by eXept Software AG
              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 simple wrapper around a WorkSpace-View, adding a pullDown menu.

    [author:]
        Claus Gittinger
"
! !

!WorkspaceApplication class methodsFor:'menu specs'!

mainMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:WorkspaceApplication andSelector:#mainMenu
     (Menu new fromLiteralArrayEncoding:(WorkspaceApplication mainMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            label: 'File'
            translateLabel: true
            submenu: 
           (Menu
              (
               (MenuItem
                  label: 'New Workspace'
                  itemValue: newWorkspace
                  translateLabel: true
                )
               (MenuItem
                  label: 'New SystemWorkspace'
                  itemValue: newSystemWorkspace
                  translateLabel: true
                )
               (MenuItem
                  label: 'New EvaluationWorkspace'
                  itemValue: newEvaluationWorkspace
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Load File...'
                  itemValue: menuLoad
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Save As...'
                  itemValue: menuSaveAs
                  translateLabel: true
                )
               (MenuItem
                  enabled: hasMultipleBuffersHolder
                  label: 'Save all As...'
                  itemValue: menuSaveAllAs
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Exit'
                  itemValue: closeRequest
                  translateLabel: true
                )
               )
              nil
              nil
            )
          )
         (MenuItem
            label: 'Buffers'
            nameKey: Buffer
            translateLabel: true
            submenu: 
           (Menu
              (
               (MenuItem
                  label: 'Add Buffer'
                  itemValue: addWorkspace
                  translateLabel: true
                )
               (MenuItem
                  enabled: anyWorkspaceVariableIsDefined
                  label: 'Add Buffer on Workspace Variables'
                  itemValue: addWorkspaceVariableInspector
                  translateLabel: true
                )
               (MenuItem
                  label: 'Add Buffer on Global Variables'
                  itemValue: addGlobalVariableInspector
                  translateLabel: true
                )
               (MenuItem
                  label: 'Add Buffer on Class Variables'
                  itemValue: addClassVariableInspector
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Add Evaluation Buffer'
                  itemValue: addEvaluationWorkspace
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Rename...'
                  itemValue: renameWorkspace
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  enabled: canRemoveWorkspace
                  label: 'Remove Buffer'
                  itemValue: removeWorkspace
                  translateLabel: true
                )
               )
              nil
              nil
            )
          )
         (MenuItem
            label: 'Edit'
            translateLabel: true
            submenu: 
           (Menu
              (
               (MenuItem
                  enabled: hasSelectionInActiveWorkspace
                  label: 'Cut'
                  itemValue: cutSelection
                  translateLabel: true
                )
               (MenuItem
                  enabled: hasSelectionInActiveWorkspace
                  label: 'Copy'
                  itemValue: copySelection
                  translateLabel: true
                )
               (MenuItem
                  label: 'Paste'
                  itemValue: paste
                  translateLabel: true
                )
               (MenuItem
                  enabled: hasHistory
                  label: 'Paste Last'
                  itemValue: pasteLastDoIt
                  translateLabel: true
                  submenuChannel: pasteRecentDoItMenu
                  keepLinkedMenu: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Select All'
                  itemValue: selectAll
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Filter Text...'
                  itemValue: filterText
                  translateLabel: true
                )
               (MenuItem
                  label: 'Process Text...'
                  itemValue: processText
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Services'
                  translateLabel: true
                  submenu: 
                 (Menu
                    (
                     (MenuItem
                        enabled: hasSelectionInActiveWorkspace
                        label: 'Google Spell'
                        itemValue: googleSpellingSuggestion
                        translateLabel: true
                      )
                     (MenuItem
                        label: 'Translate'
                        translateLabel: true
                        submenu: 
                       (Menu
                          (
                           (MenuItem
                              enabled: hasSelectionInActiveWorkspace
                              label: 'English -> German'
                              itemValue: babelFishTranslate:
                              translateLabel: true
                              argument: 'en_de'
                            )
                           (MenuItem
                              enabled: hasSelectionInActiveWorkspace
                              label: 'English -> French'
                              itemValue: babelFishTranslate:
                              translateLabel: true
                              argument: 'en_fr'
                            )
                           (MenuItem
                              enabled: hasSelectionInActiveWorkspace
                              label: 'English -> Spanish'
                              itemValue: babelFishTranslate:
                              translateLabel: true
                              argument: 'en_es'
                            )
                           (MenuItem
                              enabled: hasSelectionInActiveWorkspace
                              label: 'English -> Portuguese'
                              itemValue: babelFishTranslate:
                              translateLabel: true
                              argument: 'en_pt'
                            )
                           (MenuItem
                              label: '-'
                            )
                           (MenuItem
                              enabled: hasSelectionInActiveWorkspace
                              label: 'German -> English'
                              itemValue: babelFishTranslate:
                              translateLabel: true
                              argument: 'de_en'
                            )
                           (MenuItem
                              enabled: hasSelectionInActiveWorkspace
                              label: 'French -> English'
                              itemValue: babelFishTranslate:
                              translateLabel: true
                              argument: 'fr_en'
                            )
                           (MenuItem
                              enabled: hasSelectionInActiveWorkspace
                              label: 'Spanish -> English'
                              itemValue: babelFishTranslate:
                              translateLabel: true
                              argument: 'es_en'
                            )
                           (MenuItem
                              enabled: hasSelectionInActiveWorkspace
                              label: 'Portuguese -> English'
                              itemValue: babelFishTranslate:
                              translateLabel: true
                              argument: 'pt_en'
                            )
                           (MenuItem
                              enabled: hasSelectionInActiveWorkspace
                              label: 'Russian -> English'
                              itemValue: babelFishTranslate:
                              translateLabel: true
                              argument: 'ru_en'
                            )
                           )
                          nil
                          nil
                        )
                      )
                     (MenuItem
                        label: '-'
                      )
                     (MenuItem
                        label: 'Tea Timer'
                        itemValue: addTeaTimer
                        translateLabel: true
                      )
                     )
                    nil
                    nil
                  )
                )
               )
              nil
              nil
            )
          )
         (MenuItem
            label: 'Workspace'
            translateLabel: true
            submenu: 
           (Menu
              (
               (MenuItem
                  label: 'Add Workspace Variable...'
                  itemValue: addWorkspaceVariable
                  translateLabel: true
                )
               (MenuItem
                  enabled: anyWorkspaceVariableIsDefined
                  label: 'Remove Workspace Variable...'
                  itemValue: removeWorkspaceVariable
                  translateLabel: true
                )
               (MenuItem
                  enabled: anyWorkspaceVariableIsDefined
                  label: 'Remove all Workspace Variables...'
                  itemValue: removeAllWorkspaceVariables
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  enabled: anyWorkspaceVariableIsDefined
                  label: 'Inspect Workspace Variables'
                  itemValue: inspectWorkspaceVariables
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Settings'
                  translateLabel: true
                  submenu: 
                 (Menu
                    (
                     (MenuItem
                        label: 'Autodefine as Workspace Variable'
                        translateLabel: true
                        hideMenuOnActivated: false
                        choice: autoDefineVariables
                        choiceValue: workspace
                      )
                     (MenuItem
                        label: 'Autodefine as DoIt Variable'
                        translateLabel: true
                        hideMenuOnActivated: false
                        choice: autoDefineVariables
                        choiceValue: doIt
                      )
                     (MenuItem
                        label: 'Autodefine off'
                        translateLabel: true
                        hideMenuOnActivated: false
                        choice: autoDefineVariables
                      )
                     (MenuItem
                        label: '-'
                      )
                     (MenuItem
                        label: 'Syntax'
                        translateLabel: true
                        submenu: 
                       (Menu
                          (
                           (MenuItem
                              label: 'Smalltalk'
                              translateLabel: true
                              choice: syntaxHolder
                              choiceValue: Smalltalk
                            )
                           (MenuItem
                              label: 'JavaScript'
                              translateLabel: true
                              choice: syntaxHolder
                              choiceValue: JavaScript
                            )
                           )
                          nil
                          nil
                        )
                      )
                     )
                    nil
                    nil
                  )
                )
               )
              nil
              nil
            )
          )
         (MenuItem
            label: 'Smalltalk'
            translateLabel: true
            submenu: 
           (Menu
              (
               (MenuItem
                  enabled: hasSelectionInActiveWorkspace
                  label: 'DoIt'
                  itemValue: doIt
                  translateLabel: true
                )
               (MenuItem
                  enabled: hasSelectionInActiveWorkspace
                  label: 'PrintIt'
                  itemValue: printIt
                  translateLabel: true
                )
               (MenuItem
                  enabled: hasSelectionInActiveWorkspace
                  label: 'InspectIt'
                  itemValue: inspectIt
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  enabled: hasHistory
                  label: 'Redo Last'
                  itemValue: redoLastDoIt
                  translateLabel: true
                  submenuChannel: redoRecentDoItMenu
                  keepLinkedMenu: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  enabled: hasSelectionInActiveWorkspace
                  label: 'TimeIt'
                  itemValue: timeIt
                  translateLabel: true
                )
               (MenuItem
                  enabled: hasSelectionInActiveWorkspace
                  label: 'SpyOnIt'
                  itemValue: spyOnIt
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  enabled: hasSelectionInActiveWorkspace
                  label: 'Browse Class'
                  itemValue: browseIt
                  translateLabel: true
                )
               (MenuItem
                  enabled: hasSelectionInActiveWorkspace
                  label: 'Browse Implementors of It'
                  itemValue: browseImplementorsOfIt
                  translateLabel: true
                )
               (MenuItem
                  enabled: hasSelectionInActiveWorkspace
                  label: 'Browse References to It'
                  itemValue: browseReferencesToIt
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'FileIn Text'
                  itemValue: fileInText
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Add Global Variable...'
                  itemValue: addGlobalVariable
                  translateLabel: true
                )
               (MenuItem
                  label: 'Remove Global Variable...'
                  itemValue: removeGlobalVariable
                  translateLabel: true
                )
               )
              nil
              nil
            )
          )
         (MenuItem
            label: 'MENU_Help'
            translateLabel: true
            startGroup: conditionalRight
            submenu: 
           (Menu
              (
               (MenuItem
                  label: 'Documentation'
                  itemValue: openDocumentation
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'About this Application...'
                  itemValue: openAboutThisApplication
                  translateLabel: true
                )
               )
              nil
              nil
            )
          )
         )
        nil
        nil
      )

    "Modified: / 23-10-2006 / 23:15:23 / cg"
!

tabMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:WorkspaceApplication andSelector:#tabMenu
     (Menu new fromLiteralArrayEncoding:(WorkspaceApplication tabMenu)) startUp
    "

    <resource: #menu>

    ^
     #(#Menu
        #(
         #(#MenuItem
            #label: 'Add Tab'
            #translateLabel: true
            "/ #triggerOnDown: true
            #value: #addWorkspace
          )
         #(#MenuItem
            #label: '-'
          )
         #(#MenuItem
            #label: 'Remove Tab'
            #translateLabel: true
            "/ #triggerOnDown: true
            #value: #removeWorkspace:
            #enabled: #canRemoveWorkspace:
          )
         #(#MenuItem
            #label: '-'
          )
         #(#MenuItem
            #label: 'Rename...'
            #translateLabel: true
            "/ #triggerOnDown: true
            #value: #renameWorkspace:
          )
         )
        nil
        nil
      )
! !

!WorkspaceApplication class methodsFor:'special startup'!

openEvaluationWorkspace
    |wsApp path needRemove font|

    needRemove := true.

    wsApp := self new.
    wsApp allButOpen.
    wsApp window extent:400@500.

    wsApp addEvaluationWorkspace.
    wsApp removeWorkspace:1.
    wsApp renameWorkspace:1 to:'Evaluator'.

    wsApp openWindow.
    wsApp selectedWorkspaceIndexHolder value:1.

    "
     self openEvaluationWorkspace
    "

    "Created: / 13-10-2006 / 12:14:13 / cg"
!

openOnFile:aFilename
    "launch a new workspace on the contents of some file"

    |ws|

    ws := self openWith:nil.
    ws loadFile:aFilename.
    ^ ws

    "
     WorkspaceApplication openOnFile:'Makefile'
    "
!

openSystemWorkspace
    |wsApp path needRemove font|

    needRemove := true.

    wsApp := self new.
    wsApp allButOpen.
    wsApp window extent:640@400.

    path := (Smalltalk getSystemFileName:'README') ?  '../../README'.
    path := path asFilename.
    path isReadable ifTrue:[
        wsApp addWindow:(HVScrollableView for:Workspace) named:'README' asFirst:false.
        wsApp loadFile:path.
        wsApp removeWorkspace:1.  "/ the original Workspace
        wsApp renameWorkspace:1 to:'LICENCE README'.
        needRemove := false.
    ].

"/    path := (Smalltalk getSystemFileName:'doc/online/english/LICENCE_STX.html') ?  '../../doc/online/english/LICENCE_STX.html'.
"/    path asFilename exists ifTrue:[
"/        wsApp addWindow:(licenceView := HVScrollableView for:HTMLDocumentView) named:'License' asFirst:false.
"/        licenceView homeDocument:'../../doc/online/english/LICENCE_STX.html'.
"/        licenceView updateLabelFlag:false.
"/        needRemove ifTrue:[wsApp removeWorkspace:1].  "/ the original Workspace
"/        needRemove := false.
"/    ].

    wsApp graphicsDevice platformName = 'X11' ifTrue:[
        font := Font family:'unifont' face:'medium' style:'roman' size:16 encoding:'iso10646-1'.
        font := font onDevice:wsApp graphicsDevice ifAbsent:nil.
        font isNil ifTrue:[    
            font := Font family:'arial' face:'medium' style:'roman' size:12 encoding:'iso10646-1'.
            font := font onDevice:wsApp graphicsDevice ifAbsent:nil.
        ].
    ] ifFalse:[
        font := Font family:'Arial Unicode MS' face:'medium' style:'roman' size:10 encoding:'ms-ansi'.
        font := font onDevice:wsApp graphicsDevice ifAbsent:nil.
    ].

    #(
        ('Hello_utf8.wsp'       HELLO_UTF_FILE          'Hello'           #'utf8' )
        ('Welcome.wsp'          WELCOME_FILE            'Welcome'         nil )
        ('Setup.wsp'            SETUP_FILE              'Setup'           nil )
        ('Keyboard.wsp'         KEYBOARD_FILE           'Keyboard'        nil )
        ('GettingStarted.wsp'   GETTING_STARTED_FILE    'Getting Started' nil )
    ) do:[:quadruple |
        |file resKey title forcedEncoding pane encoding|

        file := quadruple at:1.
        resKey := quadruple at:2.
        file := self classResources string:resKey default:file.

        title := quadruple at:3.
        forcedEncoding := quadruple at:4.

        path := (Smalltalk getSystemFileName:file).

        (path notNil and:[path asFilename isReadable]) ifTrue:[
            wsApp addWindow:(pane := HVScrollableView for:Workspace) named:title asFirst:false.

            forcedEncoding notNil ifTrue:[
                encoding := forcedEncoding.
                font notNil ifTrue:[
                    pane font:font.
                ]
            ] ifFalse:[
                encoding := CharacterEncoder guessEncodingOfFile:path.
                (encoding == #'iso8859-1' or:[encoding == #'ascii']) ifTrue:[
                    encoding := nil
                ].
            ].
            wsApp loadFile:path encoding:encoding label:title.
            needRemove ifTrue:[wsApp removeWorkspace:1].  "/ the original Workspace
            needRemove := false.
        ].
    ].
    wsApp openWindow.
    wsApp selectedWorkspaceIndexHolder value:2.

    "
     self openSystemWorkspace
    "
!

openWith:initialText
    "launch a new workspace with some initial contents"

    ^ self openWith:initialText selected:false

    "
     WorkspaceApplication openWith:'Transcript showCR:''hello world'''
    "
!

openWith:initialText selected:selectedBoolean
    "launch a new workspace with some initial contents"

    |workspace|

    workspace := self new.
    workspace open.
    workspace selectedWorkspace contents:initialText selected:selectedBoolean.
    ^ workspace

    "
     WorkspaceApplication openWith:'Transcript showCR:''hello world'''
    "
! !

!WorkspaceApplication methodsFor:'aspects'!

autoDefineVariables
    autoDefineVariables isNil ifTrue:[
        autoDefineVariables := ValueHolder new.
        (UserPreferences current autoDefineWorkspaceVariables) ifTrue:[
            autoDefineVariables value:#workspace.
        ].
        autoDefineVariables onChangeSend:#autoDefineVariablesChanged to:self.
    ].
    ^ autoDefineVariables.
!

hasHistory
    ^ Workspace doItHistory size > 0.
!

setCompilerForSyntax
    |syntax|

    syntax := syntaxHolder value.
    self selectedWorkspace compilerClass:(self compilerClassForSyntaxName:syntax).
!

syntaxHolder
    syntaxHolder isNil ifTrue:[
        syntaxHolder := #Smalltalk asValue.
        syntaxHolder onChangeSend:#setCompilerForSyntax to:self
    ].
    ^ syntaxHolder
! !

!WorkspaceApplication methodsFor:'aspects-queries'!

anyWorkspaceVariableIsDefined
    ^ Workspace anyWorkspaceVariableIsDefined

    "Modified: / 20-04-2005 / 11:57:59 / cg"
! !

!WorkspaceApplication methodsFor:'defaults'!

defaultFileNameForLoad
   ^ 'file.wsp'

    "Created: / 25-10-2006 / 14:56:10 / cg"
!

defaultFileNameForSave
    ^ self selectedWorkspace defaultFileNameForFileDialog ? super defaultFileNameForSave
!

defaultFileNameForSaveAll
   ^ 'file.wsp'

    "Created: / 25-10-2006 / 14:56:04 / cg"
!

defaultPatternLoad
   ^ '*.wsp'

    "Created: / 25-10-2006 / 14:57:25 / cg"
! !

!WorkspaceApplication methodsFor:'initialization & release'!

closeRequest
    "asks for permission before closing"

    (self askIfAnyModified:'Text was not saved. Close anyway ?' yesButton:'Close') ifFalse:[
        ^ self
    ].

    ^ super closeRequest
! !

!WorkspaceApplication methodsFor:'menu-actions'!

addClassVariableInspector
    |v|

    ClassVariablesInspectorView isNil ifTrue:[
        self error:'Missing class: "ClassVariablesInspectorView"'.
        ^ self.
    ].
    v := self addInspectorOn:Smalltalk inspectorClass:ClassVariablesInspectorView suppressPseudoSlots:true.

    v fieldListLabel:'Name'.
    self renameWorkspace:(self selectedWorkspaceIndexHolder value) to:'Class Variables'.

    "Modified: / 22-10-2006 / 11:28:14 / cg"
!

addEvaluationWorkspace
    ^ self addWindow:(self createEvaluationWorkspace) named:'Eval%1'

    "Modified: / 13-10-2006 / 12:16:35 / cg"
!

addGlobalVariable
    |name nameKey selection|

    selection := self selectedWorkspacesTextView selection ? ''.

    name := Dialog 
                request:'Name of new Global Variable:'
                initialAnswer:(selection asString string)
                okLabel:'Add'
                title:'Enter Variable Name'.
    name size == 0 ifTrue:[
        ^ self
    ].
    nameKey := name asSymbol.

    (Smalltalk includesKey:nameKey) ifTrue:[
        self warn:'Global named ''' , name , ''' already exists.'.
        ^ self.
    ].
    Smalltalk at:nameKey put:nil.
!

addGlobalVariableInspector
    |v|

    SmalltalkInspectorView isNil ifTrue:[
        self error:'Missing class: "SmalltalkInspectorView"'.
        ^ self.
    ].

    v := self addInspectorOn:Smalltalk inspectorClass:SmalltalkInspectorView suppressPseudoSlots:true.

    v fieldListLabel:'Name'.
    self renameWorkspace:(self selectedWorkspaceIndexHolder value) to:'Globals (Smalltalk)'.
    ^ v

    "Modified: / 22-10-2006 / 11:28:08 / cg"
!

addInspectorOn:aValue basic:isBasicInspector suppressPseudoSlots:suppressPseudoSlots
    |inspectorClass|

    isBasicInspector ifFalse:[
        inspectorClass := aValue inspectorClass.
    ].
    inspectorClass isNil ifTrue:[
        inspectorClass := InspectorView
    ].

    ^ self
        addInspectorOn:aValue 
        inspectorClass:inspectorClass 
        suppressPseudoSlots:suppressPseudoSlots
!

addInspectorOn:aValue inspectorClass:inspectorClass suppressPseudoSlots:suppressPseudoSlots
    |view resultString|

    view := inspectorClass new.
    view suppressPseudoSlots:suppressPseudoSlots.
    view inspect:aValue.
    "/ v allowFollow:true.
    aValue isBehavior ifTrue:[
        resultString := aValue name
    ] ifFalse:[
        resultString := aValue classNameWithArticle
    ].
    self addWindow:view named:('Inspecting: ' , resultString).
    ^ view
!

addTeaTimer
    |l dt tEnd answer|

    dt := LastTeaWaitTime ? (3*60).
    answer := Dialog 
                request:'Delta-Time (seconds) or End-Time (hh:mm:ss):' 
                initialAnswer:dt printString.
    answer isEmptyOrNil ifTrue:[^ self].

    tEnd := Time readFrom:answer onError:nil.
    tEnd isNil ifTrue:[
        dt := Number readFrom:answer onError:[^ self].
        LastTeaWaitTime := dt.
        tEnd := AbsoluteTime now addSeconds:dt.
    ] ifFalse:[
        dt := tEnd - Time now.
        tEnd := tEnd asAbsoluteTime.
    ].

    l := Label new.
    l sizeFixed:true.
    l label:'Waiting ... [',dt printString,' sec]'.
    l viewBackground:Color red.
    self addWindow:l named:'TeaTimer%1'.

    [
        Error handle:[
            #intentionallyLeftBlank
        ] do:[
            |remaining|

            [AbsoluteTime now < tEnd ] whileTrue:[
                remaining := tEnd - AbsoluteTime now.
                l label:'Waiting ... [',remaining printString,' sec]'.
                Delay waitForSeconds:1.
            ].
            3 timesRepeat:[ l beep. Delay waitForSeconds:0.4 ].
            l label:'TEA is ready !!'.
            l viewBackground:Color green.
            l topView raiseDeiconified.
        ]
    ] fork.

    "Modified: / 23-11-2006 / 16:48:14 / cg"
!

addWorkspaceVariable
    |name selectedWorkspacesTextView selection|

    selectedWorkspacesTextView := self selectedWorkspacesTextView.
    selectedWorkspacesTextView notNil ifTrue:[
        selection := selectedWorkspacesTextView selection.
    ].

    name := Dialog 
                request:'Name of new Workspace Variable:'
                initialAnswer:(selection ? '') asString string
                okLabel:'Add'
                title:'Enter Variable Name'.
    name size == 0 ifTrue:[
        ^ self
    ].
    Workspace addWorkspaceVariable:name.

    "Modified: / 24-11-2006 / 12:44:16 / cg"
!

addWorkspaceVariableInspector
    |v|

    v := self addInspectorOn:(Workspace workspaceVariables) basic:false suppressPseudoSlots:true.
    v dereferenceValueHolders:true.
    v fieldListLabel:'Name'.
    self renameWorkspace:(self selectedWorkspaceIndexHolder value) to:'Variables'.
!

askForFilterBlock:message template:template rememberIn:nameOfClassVar
    |filterBlockString filterBlock dialog textHolder classVarValue|

    classVarValue := self class classVarAt:nameOfClassVar ifAbsent:nil.
    classVarValue isNil ifTrue:[
        self class classVarAt:nameOfClassVar put:template. 
        classVarValue := template.
    ].

    textHolder := ValueHolder new.
    dialog := Dialog 
                 forRequestText:(resources string:message)
                 lines:25 
                 columns:70
                 initialAnswer:classVarValue
                 model:textHolder.
    dialog addButton:(Button label:'Template' action:[textHolder value:template. textHolder changed:#value.]).
    dialog open.
    dialog accepted ifFalse:[^ nil].

    filterBlockString := textHolder value.
    self class classVarAt:nameOfClassVar put:filterBlockString. 

    filterBlock := Parser evaluate:filterBlockString.
    filterBlock isBlock ifFalse:[
        self error:'bad input for filterBlock' mayProceed:true.
        ^ nil
    ].

    ^ filterBlock
!

autoDefineVariablesChanged
    |autoDefine|

    autoDefine := autoDefineVariables value.
    UserPreferences current autoDefineWorkspaceVariables:(autoDefine == #workspace).
    workspaces do:[:each |
        each autoDefineVariables:autoDefine
    ].
!

basicInspectIt
    self inspectIt:true
!

browseImplementorsOfIt
    self selectedWorkspacesTextView browseImplementorsOfIt
!

browseIt
    self selectedWorkspacesTextView browseIt
!

browseReferencesToIt
    self selectedWorkspacesTextView browseReferencesToIt
!

clearHistory
    Workspace clearDoItHistory
!

doIt
    self selectedWorkspacesTextView doIt
!

inspectIt
    self inspectIt:false
!

inspectIt:isBasicInspector
    |ws|

    ws := self selectedWorkspacesTextView.
    ws
        do:(ws selection) 
        withValueDo:[:result | 
                        self addInspectorOn:result basic:isBasicInspector suppressPseudoSlots:false
                    ]

"/    self selectedWorkspace inspectIt
!

inspectWorkspaceVariables
    |wsvars|

    wsvars := Workspace workspaceVariables.
    wsvars size == 0 ifTrue:[
        Dialog information:'No Workspace Variables are defined'.
        ^ self
    ].
    wsvars inspect
!

newEvaluationWorkspace
    self class openEvaluationWorkspace

    "Created: / 13-10-2006 / 12:19:47 / cg"
!

newSystemWorkspace
    self class openSystemWorkspace
!

openDocumentation
    "opens the documentation file"

    self openHTMLDocument: 'tools/misc/TOP.html#WORKSPACE'
!

pasteAndExecute:aString
    self paste:aString.
    self printIt
!

printIt
    self selectedWorkspacesTextView printIt
!

processText
    |template filterBlock newList oldList answer nChanged changedLines flags|

    template :=
'"/ general text processor;
"/ the following block should evaluate to a new line, 
"/ given the original line as argument.
"/ Beginner warning: Smalltalk know-how is useful here.

[:line |
     "/ any processing on line.
     "/ Notice, that line might be a Text object (i.e. non-string),
     "/ 
     "/ Useful operations on the line are:
     "/     - '' .... '' ,                      concatenation of any prefix/suffix
     "/     - leftPaddedTo:size                 padding
     "/     - rightPaddedTo:size                padding
     "/     - copyTo:(size min:N)               
     "/     - asUppercase 
     "/     - asLowercase
     "/     - withoutSeparators                 remove whiteSpace
     "/     - asCollectionOfWords               words

     "/ makes everything bold
     "/
     "/ line allBold

     "/ first word only
     "/
     "/ line withoutSeparators asCollectionOfWords first

     "/ dummy filter (keeps all lines as-is)
     "/
     line
]
'.
    filterBlock := self askForFilterBlock:'Processing block:'
                        template:template
                        rememberIn:#LastProcessingBlockString.
    filterBlock isNil ifTrue:[^ self].

    oldList := self selectedWorkspacesTextView list.
    oldList := oldList collect:[:lineOrNil | lineOrNil ? ''].
    newList := oldList collect:[:line | |newLine|
                newLine := line.
                Error handle:[:ex |
                ] do:[
                    newLine := filterBlock value:line
                ].
                newLine
               ].
    newList := newList collect:[:line | (line isString and:[line size == 0]) ifTrue:[nil] ifFalse:[line]].

    flags := (1 to:oldList size) collect:[:i | (oldList at:i) ~= (newList at:i)].
    flags := flags select:[:flag | flag].
    nChanged := flags size.
    nChanged == 0 ifTrue:[
        self information:'No lines were changed.'.
        ^ self
    ].

    answer := Dialog confirmWithCancel:(resources 
                        string:'%1 lines changed. Change text ?'
                        with:nChanged)
                labels:#( 'Cancel' 'No, Show Changed' 'Yes').
    answer isNil ifTrue:[^ self].
    answer ifFalse:[
        changedLines := (1 to:oldList size) select:[:i | (oldList at:i) ~= (newList at:i)].
        changedLines := changedLines collect:[:i | (newList at:i)].
        TextBox openOn:(changedLines asStringCollection) title:'Changed lines'.
        ^ self.
    ].

    self selectedWorkspacesTextView list:newList.
!

redoLastDoIt
    |s|

    s := self lastDoItsString.
    s notNil ifTrue:[
        self pasteAndExecute:s
    ]
!

removeAllWorkspaceVariables
    (Dialog confirm:(resources string:'Do you really want to remove all Workspace Variables ?'))
    ifTrue:[
        Workspace removeAllWorkspaceVariables
   ].
!

removeGlobalVariable
    |name nameKey selection value|

    selection := self selectedWorkspacesTextView selection ? ''.

    name := Dialog 
                request:'Remove Global Variable:'
                initialAnswer:(selection asString string)
                okLabel:'Remove'
                title:'Remove Global'.

    name size == 0 ifTrue:[^ self].
    nameKey := name asSymbolIfInterned.
    nameKey isNil ifTrue:[^ self].

    (Smalltalk includesKey:nameKey) ifFalse:[
        self warn:('No such Global Binding: ''%1''.' bindWith:name).
        ^ self.
    ].

    value := Smalltalk at:nameKey.
    value notNil ifTrue:[
        (self confirm:('Global ''%1'' is currently bound to %2\\Remove Binding ?' bindWith:name with:value) withCRs)
        ifFalse:[
            ^ self.
        ].
    ].
    Smalltalk at:nameKey put:nil.
    Smalltalk removeKey:nameKey
!

removeWorkspaceVariable
    |name selection wsVarNames|

    wsVarNames := Workspace workspaceVariableNames.
    wsVarNames isEmpty ifTrue:[
        Dialog information:'No Workspace Variables are defined'.
        ^ self
    ].

    selection := self selectedWorkspacesTextView selection ? ''.

    name := Dialog 
                request:'Variable to remove:'
                initialAnswer:(selection asString string)
                okLabel:'Remove'
                title:'Enter Variable Name'
                list:(wsVarNames asOrderedCollection sort).      
    name isEmptyOrNil ifTrue:[
        ^ self
    ].
    Workspace removeWorkspaceVariable:name.

    "Modified: / 20-04-2005 / 11:56:28 / cg"
!

spyOnIt
    self selectedWorkspacesTextView spyOnIt
!

timeIt
    self selectedWorkspacesTextView timeIt
! !

!WorkspaceApplication methodsFor:'menu-actions-editing'!

babelFishTranslate:fromToModeString
    "translate the selected text and paste it after the selection"

    self selectedWorkspace babelFishTranslate:fromToModeString
!

fileInText
    self selectedWorkspacesTextView contentsAsString readStream fileIn
!

filterText
    |template filterBlock newList oldList answer nDeleted deletedLines|

    template :=
'"/ general text filter;
"/ the following block should evaluate to true for all lines
"/ you want to keep - lines for which the block returns false will be removed.
"/ Beginner warning: Smalltalk know-how is useful here.

[:line |
     "/ any condition on line.
     "/ Notice, that line might be a Text object (i.e. non-string),
     "/ so you may want to use line string.
     "/ 
     "/ Useful queries on the line are:
     "/     - size                   the length of the line
     "/     - hasChangeOfEmphasis    any bold, italic etc.
     "/     - startsWith:someString
     "/     - endsWith:someString

     "/ example filter (removes all empty lines)
     "/
     "/ line size > 0

     "/ example filter (removes all lines which do not end with some suffix)
     "/
     "/ (line asLowercase endsWith:''foo'') not

     "/ dummy filter (keeps all lines)
     "/
     true
]
'.

    filterBlock := self askForFilterBlock:'Filter block:'
                        template:template
                        rememberIn:#LastFilterBlockString.
    filterBlock isNil ifTrue:[^ self].

    oldList := self selectedWorkspacesTextView list.
    oldList := oldList collect:[:lineOrNil | lineOrNil ? ''].
    newList := oldList select:filterBlock.
    newList := newList collect:[:line | (line isString and:[line size == 0]) ifTrue:[nil] ifFalse:[line]].
    nDeleted := oldList size - newList size.
    nDeleted == 0 ifTrue:[
        self information:'No lines were deleted.'.
        ^ self
    ].

    answer := Dialog confirmWithCancel:(resources 
                        string:'%1 lines remain (%2 deleted). Change text ?'
                        with:newList size
                        with:nDeleted)
                labels:#( 'Cancel' 'No, Show Deleted' 'Yes').
    answer isNil ifTrue:[^ self].
    answer ifFalse:[
        deletedLines := oldList reject:filterBlock.
        TextBox openOn:(deletedLines asStringCollection) title:'Filtered lines'.
        ^ self.
    ].

    self selectedWorkspacesTextView list:newList.
!

googleSpellingSuggestion
    self selectedWorkspacesTextView googleSpellingSuggestion
!

pasteLastDoIt
    |s|

    s := self lastDoItsString.
    s notNil ifTrue:[
        self paste:s
    ]
! !

!WorkspaceApplication methodsFor:'menu-dynamic'!

pasteRecentDoItMenu
    <resource: #programMenu >

    ^ self recentDoItsMenuFor:#'paste:'
!

recentDoItsMenuFor:aSelector
    <resource: #programMenu >

    ^ [
        |doIts m classHistory currentClass|

        doIts := Workspace doItHistory.
        doIts size > 0 ifTrue:[
            m := Menu new.
            doIts do:[:doItEntry |
                |lines label item|

                label := doItEntry withoutLeadingSeparators asStringCollection first.
                (label size > 20) ifTrue:[
                    label := (label contractTo:20)
                ] ifFalse:[
                    (lines size > 1) ifTrue:[
                        label := label , '...'
                    ].
                ].
                label := '''' , label , ''''.

                item := MenuItem label:label.
                m addItem:item.
                item value:aSelector.
                item argument:doItEntry.
            ].
            m addItem: (MenuItem new label:'-').
            m addItem: (MenuItem new 
                        label: (resources string:'Clear History'); 
                        value: #clearHistory; 
                        activeHelpKey: #historyEmptyMenu;
                        translateLabel:true).
       ].
        m
    ].
!

redoRecentDoItMenu
    <resource: #programMenu >

    ^ self recentDoItsMenuFor:#'pasteAndExecute:'
! !

!WorkspaceApplication methodsFor:'private'!

askIfAnyModified:question yesButton:yesButtonText
    (workspaces contains:[:aView | self isModifiedWorkspace:aView]) ifFalse:[^ true].

    (Dialog 
        confirm:(resources stringWithCRs:question)
        yesLabel:(resources string:yesButtonText)
        noLabel:(resources string:'Cancel'))
    ifTrue:[
        "/ reset modified flag so question is asked only once
        workspaces 
            select:[:aView | (self isModifiedWorkspace:aView)]
            thenDo:[:eachModifiedTextView |
                        eachModifiedTextView modified:false.
                    ].
        ^ true
    ].
    ^ false
!

compilerClassForSyntaxName:syntax
    syntax == #Smalltalk ifTrue:[
        ^ Compiler
    ].
    syntax == #JavaScript ifTrue:[
        ^ JavaScriptCompiler
    ].
    ^ Compiler
!

createEvaluationWorkspace
    |ws l b box resultView environmentView panel workspaceVariables|

    workspaceVariables := Workspace workspaceVariables.

    panel := VariableVerticalPanel new.
    panel showHandle:true.

      box := View new.
      l := Label new.
      l label:'Eval:'.
      l layout:((0.0@0.0 corner:0.5@0.0) asLayout bottomOffset:22).
      l adjust:#left.
      box add:l.

      ws := HVScrollableView for:Workspace.
      ws autoDefineVariables:#workspace.
      ws layout:((0.0@0.0 corner:1.0@1.0) asLayout topOffset:22; bottomOffset:-22).
      box add:ws.

      b := Button new.
      b label:'DoIt'.
      b layout:((0.25@1.0 corner:0.5@1.0) asLayout topOffset:-22).
      b adjust:#left.
      b action:[ws doIt].
      box add:b.

      b := Button new.
      b label:'InspectIt'.
      b layout:((0.5@1.0 corner:0.75@1.0) asLayout topOffset:-22).
      b adjust:#left.
      b action:[ws inspectIt].
      box add:b.

      b := Button new.
      b label:'BrowseIt'.
      b layout:((0.75@1.0 corner:1.0@1.0) asLayout topOffset:-22).
      b adjust:#left.
      b action:[ws browseIt].
      box add:b.

    panel add:box.

      box := View new.
      box add:(Label new label:'Value:'; adjust:#left; layout:((0.0@0.0 corner:1.0@0.0) asLayout bottomOffset:22)).
      resultView := HVScrollableView for:TextCollector.
      box add:(resultView layout:((0@0 corner:1.0@1.0) asLayout topOffset:22); yourself).

    panel add:box.

      box := View new.
      box add:(Label new label:'Environment:'; adjust:#left; layout:((0.0@0.0 corner:1.0@0.0) asLayout bottomOffset:22)).
      environmentView := DictionaryInspectorView new.
      environmentView suppressPseudoSlots:true.
      environmentView inspect:workspaceVariables.
      environmentView dereferenceValueHolders:true.
      environmentView fieldListLabel:'Variable'.
      box add:(environmentView layout:((0@0 corner:1.0@1.0) asLayout topOffset:22); yourself).

    panel add:box.

"/     self renameWorkspace:(self selectedWorkspaceIndexHolder value) to:'Eval'.

    ws doItAction:[:theCode |
        |result resultString|

        result := ws executeDoIt:theCode.
        resultString := [
                            result storeString
                        ] on:Error do:[
                            result printString
                        ].  
                        
        resultView showCR:resultString.
        9 to:1 by:-1 do:[:h|
            (workspaceVariables includesKey:('_%1' bindWith:h-1)) ifTrue:[
                workspaceVariables 
                        at:('_%1' bindWith:h)
                        put:(workspaceVariables at:('_%1' bindWith:h-1)).
            ].
        ].
        workspaceVariables at:'_0' put:(ValueHolder with:result).
        environmentView doUpdate.
        result.
    ].
    panel relativeCorners:#(0.4 0.6 1.0).
    ^ panel

    "Modified: / 24-11-2006 / 11:06:33 / cg"
!

createWorkspace
    |ws|

    ws := (HVScrollableView for:Workspace).
    ws autoDefineVariables:autoDefineVariables.
    ^ ws
!

isModifiedWorkspace:aView
    |view|

    view := self workspaceViewOfView:aView.

    (view isNil
    or:[view modified not 
    or:[view contentsWasSaved
    or:[view contents withoutSeparators isEmpty]]]) ifTrue:[
        ^ false
    ].
    ^ true
!

lastDoItsString
    |history|

    history := Workspace doItHistory.
    history size > 0 ifFalse:[
        self selectedWorkspacesTextView flash.
        ^ nil
    ].
    ^ history first
!

syntaxNameForCompilerClass:aClass
    aClass == Compiler ifTrue:[
        ^ #Smalltalk
    ].
    aClass == JavaScriptCompiler ifTrue:[
        ^ #JavaScript
    ].
    ^ #Smalltalk
!

workspaceSelectionChanged
    |compilerClass selectedWorkspace|

    super workspaceSelectionChanged.
    selectedWorkspace := self selectedWorkspace.

    compilerClass := (selectedWorkspace or:[(selectedWorkspace isKindOf:Workspace) not])
                        ifTrue:[Compiler] 
                        ifFalse:[selectedWorkspace compilerClass].
    self syntaxHolder setValue:(self syntaxNameForCompilerClass:compilerClass).
! !

!WorkspaceApplication class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libtool/WorkspaceApplication.st,v 1.123 2006-11-24 12:08:32 cg Exp $'
! !