"{ 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'
                  #translateLabel: true
                  #triggerOnDown: true
                  #value: #addWorkspace
                )
               #(#MenuItem
                  #label: 'Rename...'
                  #translateLabel: true
                  #triggerOnDown: true
                  #value: #renameWorkspace
                )
               #(#MenuItem
                  #label: '-'
                )
               #(#MenuItem
                  #label: 'Remove'
                  #translateLabel: true
                  #triggerOnDown: true
                  #value: #removeWorkspace
                  #enabled: #canRemoveWorkspace
                )
               )
              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
                  #label: 'Browse'
                  #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'
            #translateLabel: true
            #triggerOnDown: true
            #value: #addWorkspace
          )
         #(#MenuItem
            #label: 'Rename...'
            #translateLabel: true
            #triggerOnDown: true
            #value: #renameWorkspace:
          )
         #(#MenuItem
            #label: '-'
          )
         #(#MenuItem
            #label: 'Remove'
            #translateLabel: true
            #triggerOnDown: true
            #value: #removeWorkspace:
            #enabled: #canRemoveWorkspace:
          )
         )
        nil
        nil
      )
! !

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

    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)
            (workspaces at:index) 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 tabList size > 1
! !

!WorkspaceApplication methodsFor:'initialization & release'!

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

    ^ super closeRequest
! !

!WorkspaceApplication methodsFor:'menu actions'!

addWorkspace
    |tabList wsIndex|

    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.
    ].

    tabList add:('Workspace%1' bindWith:wsIndex).
    workspaces grow:wsIndex.
    workspaces at:wsIndex put:(HVScrollableView for:Workspace).
    self selectedWorkspaceIndexHolder value:wsIndex   
!

browseIt
    self selectedWorkspace browseIt
!

copySelection
    self selectedWorkspace copySelection
!

cutSelection
    self selectedWorkspace cutSelection
!

doIt
    self selectedWorkspace doIt
!

inspectIt
    self selectedWorkspace inspectIt
!

menuLoad
    |file ws|

    (self askIfModified:'Text was modified. Load anyway ?' yesButton:'Load') ifFalse:[ ^ self].

    file := Dialog requestFileName:'Load file:'.
    file size > 0 ifTrue:[
        (ws := self selectedWorkspace) contents:file asFilename contentsOfEntireFile.
        ws modified:false.        
    ]
!

menuSaveAs
    |file ws|

    file := Dialog requestFileName:'Save file:' default:'file.wsp'. 
    file size > 0 ifTrue:[
        (ws := self selectedWorkspace) saveAs:file.
        ws modified:false.
    ]
!

openDocumentation
    "opens the documentation file"

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

paste
    self selectedWorkspace paste
!

printIt
    self selectedWorkspace printIt
!

removeWorkspace
    self removeWorkspace:(self selectedWorkspaceIndexHolder value)
!

removeWorkspace:wsIndex
    |tabList newWsIndex|

    wsIndex == self selectedWorkspaceIndexHolder value ifTrue:[
        (self askIfModified:'Text was modified. Remove anyway ?' yesButton:'Remove') ifFalse:[
            ^ self
        ].
    ].

    tabList := self tabList.

    wsIndex == tabList size ifTrue:[
        newWsIndex := wsIndex - 1.
    ] ifFalse:[
        newWsIndex := wsIndex.
    ].

    tabList removeIndex:wsIndex.
    (workspaces at:wsIndex) destroy.
    workspaces removeIndex:wsIndex.

    tabList size == 1 ifTrue:[
        self window label:(tabList at:1).
        tabList removeIndex:1
    ].

    self selectedWorkspaceIndexHolder value:newWsIndex.
    "/ to force change (update workspaceHolder - even if same index)
    self selectedWorkspaceIndexHolder changed:#value.   
!

renameWorkspace
    self renameWorkspace:(self selectedWorkspaceIndexHolder value)
!

renameWorkspace:wsIndex
    |tabList oldName newName|

    tabList := self tabList.
    tabList isEmpty ifTrue:[
        oldName := self window label
    ] ifFalse:[
        oldName := tabList at:wsIndex.
    ].
    newName := Dialog request:(resources string:'New Name for %1:' with:oldName) initialAnswer:oldName.
    newName size == 0 ifTrue:[ ^ self].

    tabList notEmpty ifTrue:[
        tabList at:wsIndex put:newName.
    ].
    wsIndex == self selectedWorkspaceIndexHolder value ifTrue:[
        self window label:newName.
    ].
! !

!WorkspaceApplication methodsFor:'private'!

askIfModified:question yesButton:yesButtonText
    "tell user, that code has been modified - let her confirm"

    |textView|

    textView := self selectedWorkspace.
    (textView modified not or:[textView contentsWasSaved]) ifTrue:[
        ^ true
    ].
    (Dialog 
        confirm:(resources string:question) withCRs
        yesLabel:(resources at:yesButtonText)
        noLabel:(resources at:'Cancel'))
    ifTrue:[
        "/ reset modified flag so question is asked only once
        textView modified:false.
        ^ true
    ].
    ^ false

    "Modified: 2.10.1997 / 14:23:47 / stefan"
!

workspaceSelectionChanged
    |wsIndex windowLabel|

    "/ self selected
    self workspaceHolder value:(self selectedWorkspace).
    wsIndex := self selectedWorkspaceIndexHolder value.

    wsIndex ~~ 0 ifTrue:[
        windowLabel := tabList at:wsIndex ifAbsent:nil.
        windowLabel notNil ifTrue:[self window label:windowLabel].
    ].
! !

!WorkspaceApplication class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libtool/WorkspaceApplication.st,v 1.5 2001-09-25 10:21:10 cg Exp $'
! !