"{ 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 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 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'!
addWindow:aWindow named:name
|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:(name bindWith:wsIndex).
workspaces grow:wsIndex.
workspaces at:wsIndex put:aWindow.
self selectedWorkspaceIndexHolder value:wsIndex
!
addWorkspace
self addWindow:(HVScrollableView for:Workspace) named:'Workspace%1'
!
basicInspectIt
self inspectIt:true
!
browseIt
self selectedWorkspacesTextView browseIt
!
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 |
basic ifFalse:[
cls := result inspectorClass.
].
cls isNil ifTrue:[
cls := InspectorView
].
v := cls new.
v inspect:result.
v allowFollow:true.
self addWindow:v named:'Inspecting: ' , result classNameWithArticle.
]
"/ 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 selectedWorkspacesTextView) contents:file asFilename contentsOfEntireFile.
ws modified:false.
]
!
menuSaveAs
|file ws|
file := Dialog requestFileName:'Save file:' default:'file.wsp'.
file size > 0 ifTrue:[
(ws := self selectedWorkspacesTextView) saveAs:file.
ws modified:false.
]
!
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
].
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 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|
"/ 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.7 2001-09-25 12:44:36 cg Exp $'
! !