"{ Package: 'stx:libtool' }"

ToolApplicationModel subclass:#WorkspaceApplication

	instanceVariableNames:'workspaces tabList selectedWorkspaceIndexHolder workspaceHolder'

	classVariableNames:''

	poolDictionaries:''

	category:'Interface-Smalltalk'

!

!WorkspaceApplication class methodsFor:'documentation'!

documentation

"

    A simple wrapper around a WorkSpace-View, adding a pullDown menu.

    [author:]

        Claus Gittinger

"

! !

!WorkspaceApplication class methodsFor:'interface specs'!

windowSpec

    "This resource specification was automatically generated

     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the UIPainter may not be able to read the specification."

    "

     UIPainter new openOnClass:WorkspaceApplication andSelector:#windowSpec

     WorkspaceApplication new openInterface:#windowSpec

     WorkspaceApplication open

    "

    <resource: #canvas>

    ^ 

     #(#FullSpec

        #name: #windowSpec

        #window: 

       #(#WindowSpec

          #label: 'Workspace'

          #name: 'Workspace'

          #min: #(#Point 10 10)

          #max: #(#Point 1024 768)

          #bounds: #(#Rectangle 16 46 448 287)

          #menu: #mainMenu

        )

        #component: 

       #(#SpecCollection

          #collection: #(

           #(#ArbitraryComponentSpec

              #name: 'WorkspaceView'

              #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)

              #hasHorizontalScrollBar: true

              #hasVerticalScrollBar: true

              #miniScrollerVertical: false

              #hasBorder: false

              #component: #Workspace

            )

           #(#NoteBookViewSpec

              #name: 'NoteBook1'

              #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)

              #model: #selectedWorkspaceIndexHolder

              #menu: #tabList

              #useIndex: true

              #accessTabMenuAction: #tabMenuAt:

              #canvas: #workspaceHolder

              #canvasInset: 0

              #canvasFrameLevel: 0

              #keepCanvasAlive: true

              #tabLevel: 2

            )

           )

        )

      )

! !

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

                  #translateLabel: true

                  #isVisible: false

                  #value: #menuNew

                )

               #(#MenuItem

                  #label: '-'

                  #isVisible: false

                )

               #(#MenuItem

                  #label: 'Load File...'

                  #translateLabel: true

                  #value: #menuLoad

                )

               #(#MenuItem

                  #label: '-'

                )

               #(#MenuItem

                  #label: 'Save As...'

                  #translateLabel: true

                  #value: #menuSaveAs

                )

               #(#MenuItem

                  #label: '-'

                )

               #(#MenuItem

                  #label: 'Exit'

                  #translateLabel: true

                  #value: #closeRequest

                )

               )

              nil

              nil

            )

          )

         #(#MenuItem

            #label: 'Workspace'

            #translateLabel: true

            #nameKey: #Workspace

            #submenu: 

           #(#Menu

              #(

               #(#MenuItem

                  #label: 'Add Buffer'

                  #translateLabel: true

                  #triggerOnDown: true

                  #value: #addWorkspace

                )

               #(#MenuItem

                  #label: 'Rename...'

                  #translateLabel: true

                  #triggerOnDown: true

                  #value: #renameWorkspace

                )

               #(#MenuItem

                  #label: '-'

                )

               #(#MenuItem

                  #label: 'Remove Buffer'

                  #translateLabel: true

                  #triggerOnDown: true

                  #value: #removeWorkspace

                  #enabled: #canRemoveWorkspace

                )

               #(#MenuItem

                  #label: '-'

                )

               #(#MenuItem

                  #label: 'New SystemWorkspace'

                  #translateLabel: true

                  #value: #newSystemWorkspace

                )

               )

              nil

              nil

            )

          )

         #(#MenuItem

            #label: 'Edit'

            #translateLabel: true

            #submenu: 

           #(#Menu

              #(

               #(#MenuItem

                  #label: 'Copy'

                  #translateLabel: true

                  #value: #copySelection

                )

               #(#MenuItem

                  #label: 'Cut'

                  #translateLabel: true

                  #value: #cutSelection

                )

               #(#MenuItem

                  #label: 'Paste'

                  #translateLabel: true

                  #value: #paste

                )

               )

              nil

              nil

            )

          )

         #(#MenuItem

            #label: 'Smalltalk'

            #translateLabel: true

            #submenu: 

           #(#Menu

              #(

               #(#MenuItem

                  #label: 'DoIt'

                  #translateLabel: true

                  #value: #doIt

                )

               #(#MenuItem

                  #label: 'PrintIt'

                  #translateLabel: true

                  #value: #printIt

                )

               #(#MenuItem

                  #label: 'InspectIt'

                  #translateLabel: true

                  #value: #inspectIt

                )

               #(#MenuItem

                  #label: '-'

                )

               #(#MenuItem

                  #translateLabel: true

                  #value: #browseIt

                )

               )

              nil

              nil

            )

          )

         #(#MenuItem

            #label: 'Help'

            #translateLabel: true

            #startGroup: #right

            #submenu: 

           #(#Menu

              #(

               #(#MenuItem

                  #label: 'Documentation'

                  #translateLabel: true

                  #value: #openDocumentation

                )

               #(#MenuItem

                  #label: '-'

                )

               #(#MenuItem

                  #label: 'About this Application...'

                  #translateLabel: true

                  #value: #openAboutThisApplication

                )

               )

              nil

              nil

            )

          )

         )

        nil

        nil

      )

!

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 Buffer'

            #translateLabel: true

            #triggerOnDown: true

            #value: #addWorkspace

          )

         #(#MenuItem

            #label: 'Rename...'

            #translateLabel: true

            #triggerOnDown: true

            #value: #renameWorkspace:

          )

         #(#MenuItem

            #label: '-'

          )

         #(#MenuItem

            #label: 'Remove Buffer'

            #translateLabel: true

            #triggerOnDown: true

            #value: #removeWorkspace:

            #enabled: #canRemoveWorkspace:

          )

         )

        nil

        nil

      )

! !

!WorkspaceApplication class methodsFor:'special startup'!

openSystemWorkspace

    |wsApp licenceView path needRemove|

    needRemove := true.

    wsApp := self new.

    wsApp allButOpen.

    wsApp window extent:640@400.

    path := (Smalltalk getSystemFileName:'README') ?  '../../README'.

    path asFilename exists ifTrue:[

        wsApp addWindow:(HVScrollableView for:Workspace) named:'README' asFirst:false.

        wsApp loadFile:path.

        wsApp removeWorkspace:1.  "/ the original Workspace

        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.

"/    ].

    path := (Smalltalk getSystemFileName:'Keyboard.wsp').

    path asFilename exists ifTrue:[

        wsApp addWindow:(HVScrollableView for:Workspace) named:'Keyboard' asFirst:false.

        wsApp loadFile:path.

        needRemove ifTrue:[wsApp removeWorkspace:1].  "/ the original Workspace

        needRemove := false.

    ].

    path := (Smalltalk getSystemFileName:'Hello.wsp').

    path asFilename exists ifTrue:[

        wsApp addWindow:(HVScrollableView for:Workspace) named:'Welcome' asFirst:false.

        wsApp loadFile:path.

        needRemove ifTrue:[wsApp removeWorkspace:1].  "/ the original Workspace

        needRemove := false.

    ].

    wsApp openWindow

    "

     self openSystemWorkspace

    "

! !

!WorkspaceApplication methodsFor:'accessing'!

selectedWorkspace

    |wsIndex|

    workspaces isNil ifTrue:[

        workspaces := OrderedCollection new.

    ].

    wsIndex := self selectedWorkspaceIndexHolder value.

    wsIndex == 0 ifTrue:[

        ^ nil

    ].

    workspaces size < wsIndex ifTrue:[

        workspaces grow:wsIndex.

        workspaces at:wsIndex put:(HVScrollableView for:Workspace).

    ].

    ^ workspaces at:wsIndex

!

tabMenuAt:index

    |m i ws|

    m := self class tabMenu.

    m := m decodeAsLiteralArray.

    i := m detectItem:[:item | item value == #removeWorkspace:] ifNone:nil.

    i notNil ifTrue:[

        i argument:index.

        index ~~ self selectedWorkspaceIndexHolder value ifTrue:[

            "/ for now: if that buffer is modified,

            "/ do not allow removing.

            "/ (must be brought to front, in order for check-for-modification to work)

            ws := workspaces at:index.

            (ws isKindOf:ScrollableView) ifTrue:[

                ws := ws scrolledView

            ].

            ((ws isKindOf:TextView) not

            or:[ ws modified ])

            ifTrue:[

                i disable

            ].

        ].

    ].

    i := m detectItem:[:item | item value == #renameWorkspace:] ifNone:nil.

    i notNil ifTrue:[

        i argument:index.

    ].

    m findGuiResourcesIn:self.

    ^ m

!

workspaceHolder

    workspaceHolder isNil ifTrue:[

        workspaceHolder := ValueHolder with:(self selectedWorkspace).

    ].

    ^ workspaceHolder

! !

!WorkspaceApplication methodsFor:'aspects'!

selectedWorkspaceIndexHolder

    selectedWorkspaceIndexHolder isNil ifTrue:[

        selectedWorkspaceIndexHolder := 1 asValue.

        selectedWorkspaceIndexHolder onChangeSend:#workspaceSelectionChanged to:self.

    ].

    ^ selectedWorkspaceIndexHolder.

!

tabList

    tabList isNil ifTrue:[

        tabList := List new.

    ].

    ^ tabList.

! !

!WorkspaceApplication methodsFor:'aspects - queries'!

canRemoveWorkspace

    ^ self canRemoveWorkspace:(self selectedWorkspaceIndexHolder value)

!

canRemoveWorkspace:idx

    ^ self tabList size > 1

"/       and:[ (self workspacesTextViewAt:(self selectedWorkspaceIndexHolder value))

! !

!WorkspaceApplication methodsFor:'initialization & release'!

closeRequest

    (self askIfModified:'Text was modified. Close anyway ?' yesButton:'Close') ifFalse:[

        ^ self

    ].

    ^ super closeRequest

! !

!WorkspaceApplication methodsFor:'menu actions'!

addWindow:aWindow named:name

    self addWindow:aWindow named:name asFirst:false

!

addWindow:aWindow named:name asFirst:asFirst

    |tabList wsIndex newSelectedIndex|

    tabList := self tabList.

    wsIndex := tabList size + 1.

    wsIndex == 1 ifTrue:[

        "/ first - add a name for the first tab

        tabList add:(self window label). "/ 'Workspace'.

        wsIndex := wsIndex + 1.

    ].

    workspaces grow:wsIndex.

    asFirst ifTrue:[

        tabList addFirst:(name bindWith:wsIndex).

        workspaces replaceFrom:2 to:wsIndex with:workspaces startingAt:1.

        newSelectedIndex := 1.

    ] ifFalse:[

        tabList addLast:(name bindWith:wsIndex).

        newSelectedIndex := wsIndex.

    ].

    workspaces at:newSelectedIndex put:aWindow.

    self selectedWorkspaceIndexHolder value:newSelectedIndex.