WorkspaceApplication.st
author Claus Gittinger <cg@exept.de>
Tue, 26 Feb 2002 14:07:21 +0100
changeset 3597 2e7fc0ae28c9
parent 3532 e38c9dd404a2
child 3648 77e7128e230f
permissions -rw-r--r--
#valueNowOrOnUnwindDo: -> #ensure:

"{ 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
                  #enabled: #hasSelectionInActiveWorkspace
                )
               #(#MenuItem
                  #label: 'Cut'
                  #translateLabel: true
                  #value: #cutSelection
                  #enabled: #hasSelectionInActiveWorkspace
                )
               #(#MenuItem
                  #label: 'Paste'
                  #translateLabel: true
                  #value: #paste
                )
               )
              nil
              nil
            )
          )
         #(#MenuItem
            #label: 'Smalltalk'
            #translateLabel: true
            #submenu: 
           #(#Menu
              #(
               #(#MenuItem
                  #label: 'DoIt'
                  #translateLabel: true
                  #value: #doIt
                  #enabled: #hasSelectionInActiveWorkspace
                )
               #(#MenuItem
                  #label: 'PrintIt'
                  #translateLabel: true
                  #value: #printIt
                  #enabled: #hasSelectionInActiveWorkspace
                )
               #(#MenuItem
                  #label: 'InspectIt'
                  #translateLabel: true
                  #value: #inspectIt
                  #enabled: #hasSelectionInActiveWorkspace
                )
               #(#MenuItem
                  #label: '-'
                )
               #(#MenuItem
                  #label: 'TimeIt'
                  #translateLabel: true
                  #value: #timeIt
                  #enabled: #hasSelectionInActiveWorkspace
                )
               #(#MenuItem
                  #label: 'SpyOnIt'
                  #translateLabel: true
                  #value: #spyOnIt
                  #enabled: #hasSelectionInActiveWorkspace
                )
               #(#MenuItem
                  #label: '-'
                )
               #(#MenuItem
                  #label: 'Browse Class'
                  #translateLabel: true
                  #value: #browseIt
                  #enabled: #hasSelectionInActiveWorkspace
                )
               #(#MenuItem
                  #label: 'Browse Implementors of it'
                  #translateLabel: true
                  #value: #browseImplementorsOfIt
                  #enabled: #hasSelectionInActiveWorkspace
                )
               #(#MenuItem
                  #label: 'Browse References to it'
                  #translateLabel: true
                  #value: #browseReferencesToIt
                  #enabled: #hasSelectionInActiveWorkspace
                )
               )
              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 notNil and:[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 notNil and:[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 notNil and:[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))
!

hasSelectionInActiveWorkspace
    ^ self selectedWorkspacesTextView selectionAsString size > 0
! !

!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.   
"/    workspaceHolder value:aWindow.
!

addWorkspace
    self addWindow:(HVScrollableView for:Workspace) named:'Workspace%1'
!

basicInspectIt
    self inspectIt:true
!

browseImplementorsOfIt
    self selectedWorkspacesTextView browseImplementorsOfIt
!

browseIt
    self selectedWorkspacesTextView browseIt
!

browseReferencesToIt
    self selectedWorkspacesTextView browseReferencesToIt
!

copySelection
    self selectedWorkspacesTextView copySelection
!

cutSelection
    self selectedWorkspacesTextView cutSelection
!

doIt
    self selectedWorkspacesTextView doIt
!

inspectIt
    self inspectIt:false
!

inspectIt:basic
    |ws obj v|

    ws := self selectedWorkspacesTextView.
    ws
        do:(ws selection) 
        withValueDo:[:result | 
                        | cls resultString|

                        basic ifFalse:[
                            cls := result inspectorClass.
                        ].
                        cls isNil ifTrue:[
                            cls := InspectorView
                        ].
                        v := cls new.
                        v inspect:result.
                        "/ v allowFollow:true.
                        result isBehavior ifTrue:[
                            resultString := result name
                        ] ifFalse:[
                            resultString := result classNameWithArticle
                        ].
                        self addWindow:v named:('Inspecting: ' , resultString).
                    ]

"/    self selectedWorkspace inspectIt
!

loadFile:aFileName 
    |file ws lbl|

    file := aFileName asFilename.
    (ws := self selectedWorkspacesTextView) contents:file contents.
    ws modified:false.

    lbl := file withoutSuffix baseName.
    tabList size <= 1 ifTrue:[
        self window label:lbl.
    ] ifFalse:[
        tabList at:self selectedWorkspaceIndexHolder value put:lbl
    ]
!

menuLoad
    |file|

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

    file := Dialog requestFileName:'Load file:' default:'file.wsp' pattern:'*.wsp'.
    file size > 0 ifTrue:[
        self loadFile:file
    ]
!

menuSaveAs
    |file ws doAppend|

    doAppend := false.
    Dialog aboutToOpenBoxNotificationSignal handle:[:n |
        |box|

        box := n parameter.
        box addButton:(Button label:'Append'
                            action:[doAppend := true. box okPressed]).
        n proceed.
    ] do:[
        file := Dialog requestFileName:'Save file:' default:'file.wsp'. 
    ].

    file size > 0 ifTrue:[
        (ws := self selectedWorkspacesTextView) saveAs:file doAppend:doAppend.
        ws modified:false.
    ]
!

newSystemWorkspace
    self class openSystemWorkspace
!

openDocumentation
    "opens the documentation file"

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

paste
    self selectedWorkspacesTextView paste
!

printIt
    self selectedWorkspacesTextView 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
    ].

    workspaceHolder value:(workspaces at:newWsIndex).
    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.
    ].
!

spyOnIt
    self selectedWorkspacesTextView spyOnIt
!

timeIt
    self selectedWorkspacesTextView timeIt
! !

!WorkspaceApplication methodsFor:'private'!

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

    |textView|

    textView := self selectedWorkspace.
    (textView isKindOf:ScrollableView) ifTrue:[
        textView := textView scrolledView
    ].
    (textView isKindOf:TextView) ifFalse:[
        ^ true
    ].
    (textView modified not 
    or:[textView contentsWasSaved
    or:[textView contents withoutSeparators isEmpty]]) 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"
!

selectedWorkspacesTextView
    |textView|

    textView := self selectedWorkspace.
    (textView isKindOf:ScrollableView) ifTrue:[
        textView := textView scrolledView
    ].
    (textView isKindOf:TextView) ifTrue:[
        ^ textView
    ].
    ^ textView workspace
!

workspaceSelectionChanged
    |wsIndex windowLabel v|

    "/ self selected
    self workspaceHolder value:(v := 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.27 2001-12-21 12:46:43 cg Exp $'
! !