"
COPYRIGHT (c) 1995 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.
"
ApplicationModel subclass:#UIPainter
instanceVariableNames:'activeHelpTool layoutTool specTool treeView selectionPanel
tabSelection specClass specSelector specSuperclass aspects'
classVariableNames:'IconStepUp IconStepOut IconStepIn IconStepDown'
poolDictionaries:''
category:'Interface-UIPainter'
!
SelectionInTreeView subclass:#TreeView
instanceVariableNames:'lastDrawnMaster cvsEventsDisabled imageMasterParent
imageMasterChild'
classVariableNames:'ImageMasterParent ImageMasterChild'
poolDictionaries:''
privateIn:UIPainter
!
!UIPainter class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1995 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
"
GUI-Builder:
this class allows the user to build its own applications providing a graphical
user interface to buildin components and to define the behavior of the components
during runtime. The resulting specifications can be installed as methods on
classes, typically subclasses of an ApplicationModel. These specifications
are used by the UIBuilder to generate the application window and its component
structues when open the application.
[start with:]
UIPainter open
[author:]
Claus Gittinger
Claus Atzkern
[see also:]
UIBuilder
ApplicationModel
UISpecification
"
! !
!UIPainter class methodsFor:'instance creation'!
listHolder:aListHolder
|application|
application := self new.
application objectList:aListHolder.
^ application open
!
openOnClass:aClass andSelector:aSelector
^ self new openOnClass:aClass andSelector:aSelector
"Created: 1.7.1997 / 19:16:59 / cg"
!
painter:aBuilderView
|application|
application := self new.
application painter:aBuilderView.
^ application open
! !
!UIPainter class methodsFor:'ST-80 queries'!
preferenceFor:aSymbol
^ false
! !
!UIPainter class methodsFor:'help specs'!
helpSpec
"return a dictionary filled with helpKey -> helptext associations.
These are used by the activeHelp tool.
"
^ super helpSpec addPairsFrom:#(
#alignSelectionCenterVer
'align selection vertical'
#alignSelectionLeft
'align selected components to the left edge of the
dominant component ( underlined )'
#alignSelectionRight
'align selected components to the right edge of the
dominant component ( underlined )'
#alignSelectionLeftAndRight
'align selected components to the right and left edge
of the dominant component ( underlined )'
#alignSelectionTop
'align selected components to the top edge of the
dominant component ( underlined )'
#alignSelectionBottom
'align selected components to the bottom edge of the
dominant component ( underlined )'
#alignSelectionTopAndBottom
'align selected components to the top and bottom edge
of the dominant component ( underlined )'
#alignSelectionCenterVer
'align selected components horizontal to the center of
the dominant component ( underlined )'
#alignSelectionCenterHor
'align selected components vertical to the center of
the dominant component ( underlined )'
#spreadSelectionVer
'vertical spacing between selected components is made the same'
#spreadSelectionHor
'horizontal spacing between selected components is made the same'
#centerSelectionHor
'center components horizontal in contained view'
#centerSelectionVer
'center vertical horizontal in contained view'
#setToDefaultExtent
'set selected components to their default extent'
#setToDefaultWidth
'set selected components to their default width'
#setToDefaultHeight
'set selected components to their default height'
#copyExtent
'copy extent of the selected component'
#pasteExtent
'change extent of all selected components to the
last copied extent'
#pasteWidth
'change width of all selected components to the
last copied extent width'
#pasteHeight
'change height of all selected components to the
last copied extent height'
#copyLayout
'copy layout of the selected component'
#pasteLayout
'change layout of all selected components to the
last copied layout'
#pasteBuffer
'paste components at current mouse position'
#pasteWithLayout
'paste components without changing their layouts'
)
! !
!UIPainter class methodsFor:'icons'!
iconAlignB
^ Image fromFile:'b_alignB.xbm'
!
iconAlignCenterH
^ Image fromFile:'b_alignCH.xbm'
!
iconAlignCenterV
^ Image fromFile:'b_alignCV.xbm'
!
iconAlignL
^ Image fromFile:'b_alignL.xbm'
!
iconAlignLR
^ Image fromFile:'b_alignLR.xbm'
!
iconAlignR
^ Image fromFile:'b_alignR.xbm'
!
iconAlignT
^ Image fromFile:'b_alignT.xbm'
!
iconAlignTB
^ Image fromFile:'b_alignTB.xbm'
!
iconStepDown
IconStepDown isNil ifTrue:[
IconStepDown := ((Image fromFile:'stepOver.xpm') rotated:90) flipHorizontal
].
^ IconStepDown
"
IconStepDown := nil
"
!
iconStepIn
IconStepIn isNil ifTrue:[
IconStepIn := ((Image fromFile:'stepIn.xpm') rotated:90) flipHorizontal
].
^ IconStepIn
!
iconStepOut
IconStepOut isNil ifTrue:[
IconStepOut := ((Image fromFile:'stepOut.xpm') rotated:90) flipHorizontal
].
^ IconStepOut
!
iconStepUp
IconStepUp isNil ifTrue:[
IconStepUp := ((Image fromFile:'stepOver.xpm') rotated:90) flipHorizontal flipVertical
].
^ IconStepUp
"
IconStepUp := nil
"
! !
!UIPainter class methodsFor:'interface specs'!
nameAndSelectorSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:UIPainter andSelector:#nameAndSelectorSpec
UIPainter new openInterface:#nameAndSelectorSpec
"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'Painter'
#'bounds:' #(#Rectangle 0 0 391 170)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#LabelSpec
#'name:' 'classLabel'
#'layout:' #(#AlignmentOrigin 50 0.11 51 0 1 0.5)
#'label:' 'class:'
#'adjust:' #right
#'resizeForLabel:' true
)
#(#LabelSpec
#'name:' 'superClassLabel'
#'layout:' #(#AlignmentOrigin 50 0.11 77 0 1 0.5)
#'label:' 'superclass:'
#'adjust:' #right
#'resizeForLabel:' true
)
#(#LabelSpec
#'name:' 'selectorLabel'
#'layout:' #(#AlignmentOrigin 50 0.11 105 0 1 0.5)
#'label:' 'selector:'
#'adjust:' #right
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'methodNameField'
#'layout:' #(#LayoutFrame 51 0.11 95 0 -2 1.0 117 0)
#'tabable:' true
#'model:' #methodNameChannel
)
#(#LabelSpec
#'name:' 'boxLabel'
#'layout:' #(#Point 2 10)
#'label:' 'class & selector for code:'
#'adjust:' #left
#'resizeForLabel:' true
)
#(#InputFieldSpec
#'name:' 'classNameField'
#'layout:' #(#LayoutFrame 51 0.11 39 0 -2 1.0 61 0)
#'tabable:' true
#'model:' #classNameChannel
)
#(#ComboBoxSpec
#'name:' 'comboBox1'
#'layout:' #(#LayoutFrame 51 0.11 67 0 0 1.0 89 0)
#'tabable:' true
#'model:' #superclassNameChannel
#'comboList:' #superclassNameDefaults
)
#(#HorizontalPanelViewSpec
#'name:' 'commitPanel'
#'layout:' #(#LayoutFrame 0 0.0 -26 1.0 0 1.0 -2 1.0)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#ActionButtonSpec
#'name:' 'button1'
#'label:' 'cancel'
#'tabable:' true
#'model:' #cancel
#'extent:' #(#Point 190 24)
)
#(#ActionButtonSpec
#'name:' 'button2'
#'label:' 'ok'
#'tabable:' true
#'isDefault:' true
#'model:' #accept
#'extent:' #(#Point 190 22)
)
)
)
#'horizontalLayout:' #fitSpace
#'verticalLayout:' #fit
#'horizontalSpace:' 3
#'verticalSpace:' 3
)
)
)
)
"Modified: 28.7.1997 / 16:49:49 / cg"
!
windowSpec
"this window spec was automatically generated by the ST/X UIPainter"
"do not manually edit this - the painter/builder may not be able to
handle the specification if its corrupted."
"
UIPainter new openOnClass:UIPainter andSelector:#windowSpec
UIPainter new openInterface:#windowSpec
"
"UIPainter open"
<resource: #canvas>
^
#(#FullSpec
#'window:'
#(#WindowSpec
#'name:' 'uIPainterView'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#'label:' 'Tree-View'
#'bounds:' #(#Rectangle 0 0 561 450)
)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#MenuPanelSpec
#'name:' 'menuPullDown'
#'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 25 0)
#'tabable:' true
#'menu:' #menuPullDown
)
#(#NoteBookViewSpec
#'name:' 'noteBook'
#'layout:' #(#LayoutFrame 0 0.4 59 0.0 0 1.0 -55 1.0)
#'enableChannel:' #enableChannel
#'tabable:' true
#'menu:' #tabList
#'style:'
#(#FontDescription
#helvetica #medium
#roman #'10'
)
#'model:' #tabModel
#'tabWidget:' #Window
#'canvas:' #noteBookView
)
#(#HorizontalPanelViewSpec
#'name:' 'modifyPanel'
#'layout:' #(#LayoutFrame 0 0.4 -55 1.0 0 1.0 -25 1.0)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#ActionButtonSpec
#'name:' 'cancelButton'
#'label:' 'cancel'
#'tabable:' true
#'model:' #cancel
#'enableChannel:' #modifiedChannel
#'extent:' #(#Point 164 24)
)
#(#ActionButtonSpec
#'name:' 'acceptButton'
#'label:' 'ok'
#'tabable:' true
#'model:' #accept
#'enableChannel:' #modifiedChannel
#'extent:' #(#Point 164 24)
)
)
)
#'level:' 0
#'horizontalLayout:' #fitSpace
#'verticalLayout:' #fitSpace
#'horizontalSpace:' 3
#'verticalSpace:' 3
)
#(#LabelSpec
#'name:' 'helpInfo'
#'layout:' #(#LayoutFrame 2 0.0 -25 1.0 -2 1.0 -2 1.0)
#'level:' -1
#'adjust:' #left
)
#(#ToggleSpec
#'name:' 'galleryLabel'
#'layout:' #(#LayoutFrame -162 1.0 1 0 -82 1.0 23 0)
#'label:' 'Gallery'
#'model:' #galleryShown
#'isTriggerOnDown:' true
#'showLamp:' true
#'lampColor:' #(#Color 100.0 100.0 0.0)
)
#(#ToggleSpec
#'name:' 'painterLabel'
#'layout:' #(#LayoutFrame -81 1.0 1 0 -1 1.0 23 0)
#'label:' 'Painter'
#'model:' #painterShown
#'isTriggerOnDown:' true
#'showLamp:' true
#'lampColor:' #(#Color 100.0 100.0 0.0)
)
#(#ArbitraryComponentSpec
#'name:' 'treeView'
#'layout:' #(#LayoutFrame 0 0.0 59 0 0 0.4 -25 1.0)
#'menu:' #menuCanvas
#'hasHorizontalScrollBar:' true
#'hasVerticalScrollBar:' true
#'miniScrollerHorizontal:' true
#'miniScrollerVertical:' true
#'component:' #treeView
#'hasBorder:' false
)
#(#HorizontalPanelViewSpec
#'name:' 'menuContainer'
#'layout:' #(#LayoutFrame 0 0.0 26 0 0 1.0 58 0)
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#MenuPanelSpec
#'name:' 'menuMove'
#'menu:' #menuMove
#'showSeparatingLines:' true
#'extent:' #(#Point 123 32)
)
#(#MenuPanelSpec
#'name:' 'menuAlignment'
#'tabable:' true
#'menu:' #menuAlignment
#'showSeparatingLines:' true
#'extent:' #(#Point 233 32)
)
#(#HorizontalPanelViewSpec
#'name:' 'panelViewButtons'
#'component:'
#(#SpecCollection
#'collection:'
#(
#(#ArrowButtonSpec
#'name:' 'moveLeft'
#'tabable:' true
#'model:' #moveSelectionLeft
#'isTriggerOnDown:' true
#'enableChannel:' #hasValidSelection
#'direction:' #left
#'extent:' #(#Point 25 24)
)
#(#ArrowButtonSpec
#'name:' 'moveRight'
#'model:' #moveSelectionRight
#'isTriggerOnDown:' true
#'enableChannel:' #hasValidSelection
#'direction:' #right
#'extent:' #(#Point 26 24)
)
#(#ArrowButtonSpec
#'name:' 'moveDown'
#'model:' #moveSelectionDown
#'isTriggerOnDown:' true
#'enableChannel:' #hasValidSelection
#'direction:' #down
#'extent:' #(#Point 26 24)
)
#(#ArrowButtonSpec
#'name:' 'moveUp'
#'model:' #moveSelectionUp
#'isTriggerOnDown:' true
#'enableChannel:' #hasValidSelection
#'direction:' #up
#'extent:' #(#Point 22 24)
)
)
)
#'level:' 1
#'horizontalLayout:' #spreadSpace
#'verticalLayout:' #fitSpace
#'horizontalSpace:' 4
#'verticalSpace:' 4
#'extent:' #(#Point 125 32)
)
)
)
#'horizontalLayout:' #spread
#'verticalLayout:' #fit
#'horizontalSpace:' 3
#'verticalSpace:' 3
)
)
)
)
! !
!UIPainter class methodsFor:'menu specs'!
menuAlignment
"this window spec was automatically generated by the ST/X MenuEditor"
"do not manually edit this - the builder may not be able to
handle the specification if its corrupted."
"
MenuEditor new openOnClass:UIPainter andSelector:#menuAlignment
(Menu new fromLiteralArrayEncoding:(UIPainter menuAlignment)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#'label:' 'align left'
#'value:' #alignSelectionLeft
#'enabled:' #hasValidSelection
#'activeHelpKey:' #alignSelectionLeft
#'labelImage:'
#(#ResourceRetriever
nil #iconAlignL
)
)
#(#MenuItem
#'label:' 'align right'
#'value:' #alignSelectionRight
#'enabled:' #hasValidSelection
#'activeHelpKey:' #alignSelectionRight
#'labelImage:'
#(#ResourceRetriever
nil #iconAlignR
)
)
#(#MenuItem
#'label:' 'align left & right'
#'value:' #alignSelectionLeftAndRight
#'enabled:' #hasValidSelection
#'activeHelpKey:' #alignSelectionLeftAndRight
#'labelImage:'
#(#ResourceRetriever
nil #iconAlignLR
)
)
#(#MenuItem
#'label:' 'align top'
#'value:' #alignSelectionTop
#'enabled:' #hasValidSelection
#'activeHelpKey:' #alignSelectionTop
#'labelImage:'
#(#ResourceRetriever
nil #iconAlignT
)
)
#(#MenuItem
#'label:' 'align bottom'
#'value:' #alignSelectionBottom
#'enabled:' #hasValidSelection
#'activeHelpKey:' #alignSelectionBottom
#'labelImage:'
#(#ResourceRetriever
nil #iconAlignB
)
)
#(#MenuItem
#'label:' 'align top & bottom'
#'value:' #alignSelectionTopAndBottom
#'enabled:' #hasValidSelection
#'activeHelpKey:' #alignSelectionTopAndBottom
#'labelImage:'
#(#ResourceRetriever
nil #iconAlignTB
)
)
#(#MenuItem
#'label:' 'align centered horizontal'
#'value:' #alignSelectionCenterHor
#'enabled:' #hasValidSelection
#'activeHelpKey:' #alignSelectionCenterHor
#'labelImage:'
#(#ResourceRetriever
nil #iconAlignCenterH
)
)
#(#MenuItem
#'label:' 'align centered vertical'
#'value:' #alignSelectionCenterVer
#'enabled:' #hasValidSelection
#'activeHelpKey:' #alignSelectionCenterVer
#'labelImage:'
#(#ResourceRetriever
nil #iconAlignCenterV
)
)
)
#( 3 3 )
nil
)
!
menuCanvas
"this window spec was automatically generated by the ST/X MenuEditor"
"do not manually edit this - the builder may not be able to
handle the specification if its corrupted."
"
MenuEditor new openOnClass:UIPainter andSelector:#menuCanvas
(Menu new fromLiteralArrayEncoding:(UIPainter menuCanvas)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#'label:' 'copy'
#'value:' #copySelection
#'shortcutKeyCharacter:' #Copy
)
#(#MenuItem
#'label:' 'cut'
#'value:' #deleteSelection
#'shortcutKeyCharacter:' #Cut
)
#(#MenuItem
#'label:' 'paste'
#'nameKey:' #paste
#'value:' #paste
#'submenu:'
#(#Menu
#(
#(#MenuItem
#'label:' 'paste'
#'value:' #pasteBuffer
#'activeHelpKey:' #pasteBuffer
#'shortcutKeyCharacter:' #Paste
)
#(#MenuItem
#'label:' 'keep layout'
#'value:' #pasteWithLayout
#'activeHelpKey:' #pasteWithLayout
)
) nil
nil
)
)
#(#MenuItem
#'label:' '-'
)
#(#MenuItem
#'label:' 'undo'
#'nameKey:' #undo
#'value:' #undoLast
)
#(#MenuItem
#'label:' '-'
)
#(#MenuItem
#'label:' 'dimension'
#'value:' #dimension
#'submenu:'
#(#Menu
#(
#(#MenuItem
#'label:' 'default extent'
#'value:' #setToDefaultExtent
#'activeHelpKey:' #setToDefaultExtent
)
#(#MenuItem
#'label:' 'default width'
#'value:' #setToDefaultWidth
#'activeHelpKey:' #setToDefaultWidth
)
#(#MenuItem
#'label:' 'default height'
#'value:' #setToDefaultHeight
#'activeHelpKey:' #setToDefaultHeight
)
#(#MenuItem
#'label:' 'copy extent'
#'value:' #copyExtent
#'activeHelpKey:' #copyExtent
)
#(#MenuItem
#'label:' 'paste extent'
#'value:' #pasteExtent
#'activeHelpKey:' #pasteExtent
)
#(#MenuItem
#'label:' 'paste width'
#'value:' #pasteWidth
#'activeHelpKey:' #pasteWidth
)
#(#MenuItem
#'label:' 'paste height'
#'value:' #pasteHeight
#'activeHelpKey:' #pasteHeight
)
#(#MenuItem
#'label:' 'copy layout'
#'value:' #copyLayout
#'activeHelpKey:' #copyLayout
)
#(#MenuItem
#'label:' 'paste layout'
#'value:' #pasteLayout
#'activeHelpKey:' #pasteLayout
)
)
#(3 1 3)
nil
)
)
#(#MenuItem
#'label:' 'align'
#'value:' #align
#'submenu:'
#(#Menu
#(
#(#MenuItem
#'label:' 'align left'
#'value:' #alignSelectionLeft
#'activeHelpKey:' #alignSelectionLeft
#'labelImage:'
#(#ResourceRetriever
#UIPainter #iconAlignL
'align left'
)
)
#(#MenuItem
#'label:' 'align right'
#'value:' #alignSelectionRight
#'activeHelpKey:' #alignSelectionRight
#'labelImage:'
#(#ResourceRetriever
#UIPainter #iconAlignR
'align right'
)
)
#(#MenuItem
#'label:' 'align left & right'
#'value:' #alignSelectionLeftAndRight
#'activeHelpKey:' #alignSelectionLeftAndRight
#'labelImage:'
#(#ResourceRetriever
#UIPainter #iconAlignLR
'align left & right'
)
)
#(#MenuItem
#'label:' 'align top'
#'value:' #alignSelectionTop
#'activeHelpKey:' #alignSelectionTop
#'labelImage:'
#(#ResourceRetriever
#UIPainter #iconAlignT
'align top'
)
)
#(#MenuItem
#'label:' 'align bottom'
#'value:' #alignSelectionBottom
#'activeHelpKey:' #alignSelectionBottom
#'labelImage:'
#(#ResourceRetriever
#UIPainter #iconAlignB
'align bottom'
)
)
#(#MenuItem
#'label:' 'align top & bottom'
#'value:' #alignSelectionTopAndBottom
#'activeHelpKey:' #alignSelectionTopAndBottom
#'labelImage:'
#(#ResourceRetriever
#UIPainter #iconAlignTB
'align top & bottom'
)
)
#(#MenuItem
#'label:' 'align centered horizontal'
#'value:' #alignSelectionCenterHor
#'activeHelpKey:' #alignSelectionCenterHor
#'labelImage:'
#(#ResourceRetriever
#UIPainter #iconAlignCenterH
'align centered horizontal'
)
)
#(#MenuItem
#'label:' 'align centered vertical'
#'value:' #alignSelectionCenterVer
#'activeHelpKey:' #alignSelectionCenterVer
#'labelImage:'
#(#ResourceRetriever
#UIPainter #iconAlignCenterV
'align centered vertical'
)
)
#(#MenuItem
#'label:' 'spread horizontal'
#'value:' #spreadSelectionHor
#'activeHelpKey:' #spreadSelectionHor
)
#(#MenuItem
#'label:' 'spread vertical'
#'value:' #spreadSelectionVer
#'activeHelpKey:' #spreadSelectionVer
)
#(#MenuItem
#'label:' 'center horizontal in frame'
#'value:' #centerSelectionHor
#'activeHelpKey:' #centerSelectionHor
)
#(#MenuItem
#'label:' 'center vertical in frame'
#'value:' #centerSelectionVer
#'activeHelpKey:' #centerSelectionVer
)
)
#(8 2)
nil
)
)
) nil
nil
)
!
menuMove
"this window spec was automatically generated by the ST/X MenuEditor"
"do not manually edit this - the builder may not be able to
handle the specification if its corrupted."
"
MenuEditor new openOnClass:UIPainter andSelector:#menuMove
(Menu new fromLiteralArrayEncoding:(UIPainter menuMove)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#'label:' 'stepUp'
#'value:' #doStepUp
#'enabled:' #hasSingleSelection
#'labelImage:'
#(#ResourceRetriever
#UIPainter #iconStepUp
)
)
#(#MenuItem
#'label:' 'stepDown'
#'value:' #doStepDown
#'enabled:' #hasSingleSelection
#'labelImage:'
#(#ResourceRetriever
#UIPainter #iconStepDown
)
)
#(#MenuItem
#'label:' 'stepIn'
#'value:' #doStepIn
#'enabled:' #canStepIn
#'labelImage:'
#(#ResourceRetriever
#UIPainter #iconStepIn
)
)
#(#MenuItem
#'label:' 'stepOut'
#'value:' #doStepOut
#'enabled:' #canStepOut
#'labelImage:'
#(#ResourceRetriever
#UIPainter #iconStepOut
)
)
)
#( 2 )
nil
)
!
menuPullDown
"this window spec was automatically generated by the ST/X MenuEditor"
"do not manually edit this - the builder may not be able to
handle the specification if its corrupted."
"
MenuEditor new openOnClass:UIPainter andSelector:#menuPullDown
(Menu new fromLiteralArrayEncoding:(UIPainter menuPullDown)) startUp
"
<resource: #menu>
^
#(#Menu
#(
#(#MenuItem
#'label:' 'file'
#'value:' #file
#'enabled:' #enableChannel
#'submenu:'
#(#Menu
#(
#(#MenuItem
#'label:' 'new'
#'value:' #doNew
)
#(#MenuItem
#'label:' 'from class ...'
#'value:' #doFromClass
)
#(#MenuItem
#'label:' 'pick a view '
#'value:' #doPickAView
)
#(#MenuItem
#'label:' '-'
)
#(#MenuItem
#'label:' 'quit'
#'value:' #closeRequest
)
) nil
nil
)
)
#(#MenuItem
#'label:' 'misc'
#'value:' #misc
#'enabled:' #enableChannel
#'submenu:'
#(#Menu
#(
#(#MenuItem
#'label:' 'grid'
#'value:' #grid
#'submenu:'
#(#Menu
#(
#(#MenuItem
#'label:' 'show'
#'indication:' #'gridShown:'
)
#(#MenuItem
#'label:' 'align'
#'indication:' #'gridAlign:'
)
) nil
nil
)
)
#(#MenuItem
#'label:' 'undo'
#'value:' #undo
#'submenu:'
#(#Menu
#(
#(#MenuItem
#'label:' 'last'
#'value:' #undoLast
)
#(#MenuItem
#'label:' 'menu'
#'value:' #openUndoMenu
)
#(#MenuItem
#'label:' '-'
)
#(#MenuItem
#'label:' 'delete'
#'value:' #removeUndoHistory
)
) nil
nil
)
)
) nil
nil
)
)
#(#MenuItem
#'label:' 'code'
#'value:' #code
#'enabled:' #enableChannel
#'submenu:'
#(#Menu
#(
#(#MenuItem
#'label:' 'class && method ...'
#'value:' #defineClassAndSelector
)
#(#MenuItem
#'label:' '='
)
#(#MenuItem
#'label:' 'install window spec.'
#'value:' #doInstallSpec
#'enabled:' #hasSpecClassAndSelector
)
#(#MenuItem
#'label:' 'install help spec.'
#'value:' #doInstallHelp
#'enabled:' #hasSpecClass
)
#(#MenuItem
#'label:' '-'
)
#(#MenuItem
#'label:' 'install aspects'
#'value:' #doInstallAspects
#'enabled:' #hasSpecClass
)
#(#MenuItem
#'label:' '='
)
#(#MenuItem
#'label:' 'show window spec.'
#'value:' #doWindowSpec
)
#(#MenuItem
#'label:' '='
)
#(#MenuItem
#'label:' 'browse application'
#'value:' #doBrowseAppClass
#'enabled:' #hasSpecClass
)
#(#MenuItem
#'label:' 'start application'
#'value:' #doStartApplication
#'enabled:' #hasSpecClass
)
) nil
nil
)
)
#(#MenuItem
#'label:' 'test'
#'nameKey:' #test
#'value:' #test
#'submenu:'
#(#Menu
#(
#(#MenuItem
#'label:' 'test mode'
#'indication:' #'testMode:'
)
) nil
nil
)
)
) nil
nil
)
! !
!UIPainter methodsFor:'accessing menu'!
menuCanvas
^ [ treeView canvas showMiddleButtonMenu ]
!
menuMove
"this window spec was automatically generated by the ST/X MenuEditor"
^ self class menuMove
!
menuPullDown
"this window spec was automatically generated by the ST/X MenuEditor"
^ self class menuPullDown
! !
!UIPainter methodsFor:'actions'!
accept
|layout|
self isLayoutToolSelected ifTrue:[
(layout := layoutTool layout) notNil ifTrue:[
layoutTool layoutType == #Extent ifTrue:[
self painter setExtent:layout
] ifFalse:[
self painter setLayout:layout
]
]
] ifFalse:[
self isHelpToolSelected ifTrue:[
activeHelpTool accept
].
self painter updateFromSpec:(specTool specification).
].
self modifiedChannel value:false.
!
cancel
"cancel all changes and read back attributes from current view
"
self isModified ifTrue:[
specTool specification:(self painter specForSelection).
layoutTool layoutView:(layoutTool layoutView).
self modifiedChannel value:false.
]
!
openEditMenu
|cls aspect editor|
specClass isNil ifTrue:[
^ self information:'no application class defined yet'.
].
(cls := specClass) isBehavior ifFalse:[
cls := Smalltalk at:specClass asSymbol.
cls isNil ifTrue:[
^ self information:'no application class defined yet'
]
].
cls notNil ifTrue:[
(aspect := specTool specification menu) notNil ifTrue:[
aspect := aspect asSymbol
] ifFalse:[
"/ cg: q&d hack ...
aspect := treeView propertySelected.
aspect notNil ifTrue:[
Object errorSignal handle:[:ex |
aspect := nil.
] do:[
aspect := aspect view asMenu.
]
].
"/ aspect isNil ifTrue:[
"/ self warn:'first enter (and confirm) the menus selector.'.
"/ ^ self.
"/ ].
].
editor := MenuEditor new.
editor masterApplication:self.
editor activeHelpTool:(self activeHelpTool).
editor openModalOnClass:cls andSelector:aspect.
editor selectorName ~= aspect ifTrue:[
editor didInstall ifTrue:[
specTool specification menu:editor selectorName asSymbol.
self modifiedChannel value:true.
self accept
]
].
]
"Modified: 31.7.1997 / 14:26:13 / cg"
! !
!UIPainter methodsFor:'active help'!
activeHelpTool
"setup help tool
"
activeHelpTool isNil ifTrue:[
activeHelpTool := UIHelpTool new.
activeHelpTool helpSpecFrom:specClass.
activeHelpTool masterApplication:self.
].
^ activeHelpTool
!
showHelp:aHelpText for:view
"hook to allow an application to display active help
texts in its own info area.
This method may be redefined in a concrete application.
If it returns false, the ActiveHelp manager will popup a
bubble with the help text."
|l|
(l := self builder componentAt:#helpInfo) notNil ifTrue:[
aHelpText replaceAll:(Character cr) by:(Character space).
l label:aHelpText.
^ true.
].
^ false
! !
!UIPainter methodsFor:'aspects'!
canStepIn
^ builder booleanValueAspectFor:#canStepIn
"Modified: 28.7.1997 / 12:52:16 / cg"
!
canStepOut
^ builder booleanValueAspectFor:#canStepOut
"Modified: 28.7.1997 / 12:52:18 / cg"
!
enableChannel
"true if modifications are allowed otherwise running test
"
^ self painter enableChannel
!
galleryShown
|holder|
(holder := builder bindingAt:#galleryShown) isNil ifTrue:[
builder aspectAt:#galleryShown put:(holder := true asValue).
holder addDependent:self
].
^ holder
!
hasSingleSelection
^ builder booleanValueAspectFor:#hasSingleSelection
"Modified: 28.7.1997 / 12:52:20 / cg"
!
hasValidSelection
^ builder booleanValueAspectFor:#hasValidSelection
"Modified: 28.7.1997 / 12:52:22 / cg"
!
modifiedChannel
^ builder booleanValueAspectFor:#modifiedChannel
"Modified: 28.7.1997 / 12:52:24 / cg"
!
noteBookView
"automatically generated by UIPainter ..."
|noteBook channel n1 n2|
(noteBook := builder bindingAt:#noteBookView) isNil ifTrue:[
noteBook := View new.
layoutTool := UILayoutTool new.
specTool := UISpecificationTool new.
channel := self modifiedChannel.
layoutTool masterApplication:self.
specTool masterApplication:self.
n1 := SubCanvas origin:0.0@0.0 corner:1.0@1.0 in:noteBook.
n2 := SubCanvas origin:0.0@0.0 corner:1.0@1.0 in:noteBook.
n1 client:layoutTool.
specTool builder:(n2 client:specTool).
layoutTool masterApplication:self.
specTool masterApplication:self.
layoutTool modifiedHolder:channel.
specTool modifiedHolder:channel.
builder aspectAt:#noteBookView put:noteBook.
].
^ noteBook
!
objectList
^ nil
"
|holder|
(holder := builder bindingAt:#objectList) isNil ifTrue:[
builder aspectAt:#objectList put:(holder := SelectionInList).
].
^ holder
"
!
objectListMenu
"returns a block which returns the menu
!!hack!!
"
^ [ self painter showMiddleButtonMenu ].
!
painterShown
|holder|
(holder := builder bindingAt:#painterShown) isNil ifTrue:[
builder aspectAt:#painterShown put:(holder := true asValue).
holder addDependent:self
].
^ holder
!
tabList
"automatically generated by UIPainter ..."
|holder|
(holder := builder bindingAt:#tabList) isNil ifTrue:[
builder aspectAt:#tabList put:(holder := ValueHolder new).
holder value:#( 'Properties' ).
].
^ holder
!
tabModel
"automatically generated by UIPainter ..."
|holder|
(holder := builder bindingAt:#tabModel) isNil ifTrue:[
holder := AspectAdaptor new subject:self; forAspect:#tabSelection.
builder aspectAt:#tabModel put:holder.
].
^ holder
!
treeView
^ treeView
! !
!UIPainter methodsFor:'binding access'!
aspectFor:aKey
"aspect for a key
"
^ aspects at:aKey ifAbsent:[ super aspectFor:aKey ]
! !
!UIPainter methodsFor:'change & update'!
layoutChanged
self isModified ifFalse:[
layoutTool update.
self modifiedChannel value:false
]
!
propertyChanged
"property changed
"
|p|
(p := treeView propertySelected) notNil ifTrue:[
specTool specification:(p spec copy).
layoutTool layoutView:(p view).
self modifiedChannel value:false
] ifFalse:[
layoutTool layoutView notNil ifTrue:[
self modifiedChannel value:false.
self treeSelection
]
]
!
update:something with:aParameter from:someObject
someObject == treeView model ifTrue:[
something == #selection ifTrue:[self treeSelection].
^ self
].
self galleryShown == someObject ifTrue:[
(self galleryShown value) ifTrue:[
self raiseUIView:(selectionPanel window)
] ifFalse:[
self hideUIView:(selectionPanel window)
].
^ self
].
self painterShown == someObject ifTrue:[
(self painterShown value) ifTrue:[
self raiseUIView:(self painter topView)
] ifFalse:[
self hideUIView:(self painter topView)
].
^ self
].
! !
!UIPainter methodsFor:'event handling'!
doesNotUnderstand:aMessage
|painter|
painter := self painter.
(painter respondsTo:(aMessage selector)) ifTrue:[
^ aMessage sendTo:painter
].
super doesNotUnderstand:aMessage
! !
!UIPainter methodsFor:'private'!
hideUIView:aView
aView beIndependent.
aView unmap.
!
painter
^ treeView canvas
!
raiseUIView:aView
aView map.
aView bePartner.
!
setClass:cls selector:selector
|clsName superClassName|
clsName := cls name.
superClassName := cls superclass name.
(self aspectFor:#classNameChannel) value:clsName.
(self aspectFor:#methodNameChannel) value:(selector ? '').
(self aspectFor:#superclassNameChannel) value:superClassName.
self painter
className:clsName
superclassName:superClassName
selector:(selector ? '').
specClass := clsName.
specSelector := (selector ? '').
specSuperclass := superClassName.
"Modified: 24.6.1997 / 19:07:01 / cg"
! !
!UIPainter methodsFor:'queries'!
hasSpecClass
specClass notNil ifTrue:[
^ (specClass isBehavior or:[(Smalltalk at:specClass asSymbol) notNil])
].
^ false
!
hasSpecClassAndSelector
specSelector size > 1 ifTrue:[
^ self hasSpecClass
].
^ false
!
isHelpToolSelected
^ tabSelection = 'Help'
!
isLayoutToolSelected
^ tabSelection = layoutTool class label
!
isModified
"returns true if current spec. is modified
"
^ self modifiedChannel value
!
isPainterEnabled
^ self painter enabled
! !
!UIPainter methodsFor:'selection'!
tabSelection
"returns current name of section
"
^ tabSelection
!
tabSelection:something
"section changed
"
|raiseViewIdx|
(something isNil or:[tabSelection = something]) ifTrue:[
^ self
].
self isModified ifTrue:[
(self confirm:'accept change made in ' , tabSelection printString , ' section ?') ifFalse:[
^ self
].
self accept
].
raiseViewIdx := 1.
tabSelection := something.
self isLayoutToolSelected ifFalse:[
specTool selection:tabSelection.
raiseViewIdx := 2
].
(self noteBookView subViews at:raiseViewIdx) raise.
self cancel.
!
treeSelection
"called whenever tree-selection changed
"
|oldSelection view slices list spec props size nameOfSpec|
self isModified ifTrue:[
(self confirm:'accept change made in ' , tabSelection printString , ' section ?') ifTrue:[
self accept
]
].
props := treeView propertySelected.
oldSelection := tabSelection.
tabSelection := nil.
self hasValidSelection value:(treeView hasValidSelection).
self canStepIn value:(treeView canStepIn).
self canStepOut value:(treeView canStepOut).
props isNil ifFalse:[
self hasSingleSelection value:true.
view := props view.
spec := props spec copy.
layoutTool layoutView == view ifFalse:[
slices := spec class slices.
size := slices size + 1.
list := Array new:size.
slices keysAndValuesDo:[:i :s|list at:i put:(s first asString)].
list at:size put:(layoutTool class label).
(self tabList) value:list.
] ifTrue:[
list := self tabList value
].
(list findFirst:[:n| n = oldSelection ]) ~~ 0 ifTrue:[
tabSelection := oldSelection
] ifFalse:[
tabSelection := list first
].
nameOfSpec := spec class name.
] ifTrue:[
self hasSingleSelection value:false.
nameOfSpec := ''
].
self showHelp:nameOfSpec for:nil.
layoutTool layoutView:view.
specTool specification:spec.
tabSelection notNil ifTrue:[
self isLayoutToolSelected ifTrue:[
(self noteBookView subViews at:1) raise
] ifFalse:[
specTool selection:tabSelection.
(self noteBookView subViews at:2) raise
]
].
(builder componentAt:#noteBook) setSelection:tabSelection.
self modifiedChannel value:false.
! !
!UIPainter methodsFor:'startup / release'!
closeRequest
"close all windows open by builder
"
self painter isModified ifTrue:[
(self confirm:'quit without without saving your modifications ?') ifFalse:[
^ self
]
].
treeView model removeDependent:self.
self painter release.
selectionPanel notNil ifTrue:[
selectionPanel masterApplication:nil.
selectionPanel closeRequest
].
selectionPanel := nil.
layoutTool := nil.
treeView := nil.
activeHelpTool := nil.
super closeRequest.
"Modified: 28.7.1997 / 18:28:37 / cg"
!
closeRequestFor:aTopView
"handle a close request for a specific view
"
|topView|
topView := self window.
topView == aTopView ifTrue:[
super closeRequestFor:aTopView
] ifFalse:[
aTopView = selectionPanel window ifTrue:[
self galleryShown value:false
] ifFalse:[
self painterShown value:false
].
topView raise.
].
!
openInterface
"open interfaces
"
|painterView painter cls topView|
aspects := IdentityDictionary new.
aspects at:#classNameChannel put:(
(specClass notNil ifTrue:[specClass]
ifFalse:['NewApplication']) asValue
).
specSuperclass isNil ifTrue:[
specClass notNil ifTrue:[
(cls := Smalltalk at:specClass asSymbol) notNil ifTrue:[
specSuperclass := cls superclass name.
]
]
].
aspects at:#superclassNameChannel put:(
(specSuperclass notNil ifTrue:[specSuperclass]
ifFalse:['ApplicationModel']) asValue
).
aspects at:#superclassNameDefaults put:#('ApplicationModel' 'SimpleDialog') asValue.
aspects at:#methodNameChannel put:(
(specSelector notNil ifTrue:[specSelector asValue]
ifFalse:[#windowSpec]) asValue
).
treeView := TreeView new.
painterView := StandardSystemView new.
painterView label:'unnamed canvas'.
painterView extent:300@300.
painter := UIPainterView in:painterView.
painter layout:(0.0 @ 0.0 corner:1.0 @ 1.0) asLayout.
treeView := treeView canvas:painter.
painter treeView:treeView.
treeView model addDependent:self.
super openInterface.
topView := self window.
topView bePartner.
topView label:'GUI Builder'.
topView icon:(Image fromFile:'bitmaps/UIPainter.xbm' resolution:100).
painterView openInGroup:(topView windowGroup).
painterView bePartner.
painterView application:self.
painterView open.
painterView application:self.
selectionPanel := UISelectionPanel new.
selectionPanel allButOpenInterface:#windowSpec.
selectionPanel window openInGroup:(topView windowGroup).
selectionPanel window bePartner.
selectionPanel openWindow.
selectionPanel masterApplication:self.
"Modified: 1.8.1997 / 14:22:10 / cg"
!
openNewWindowCanvas
"open new
"
self open.
!
openOnClass:aClass
"open up an interface builder
"
self openOnClass:aClass andSelector:#windowSpec
!
openOnClass:aClass andSelector:aSelector
"open up an interface builder, fetching a spec from someClass
via some selector
"
|painter|
aClass isNil ifTrue:[
self warn:'nil class given (class was probably renamed ?)'.
].
self openInterface.
aClass notNil ifTrue:[
painter := self painter.
self setClass:aClass selector:aSelector.
"/ specClass := aClass name.
"/ specSuperclass := aClass superclass name.
"/ specSelector := aSelector.
"/
"/ (aspects at:#classNameChannel) value:specClass.
"/ (aspects at:#superclassNameChannel) value:specSuperclass.
"/ (aspects at:#methodNameChannel) value:specSelector asSymbol.
"/
"/ painter
"/ className:aClass name
"/ superclassName:aClass superclass name
"/ selector:aSelector.
(aClass respondsTo:aSelector) ifTrue:[
painter setupFromSpec:(aClass perform:aSelector).
]
]
"Modified: 1.7.1997 / 19:18:54 / cg"
! !
!UIPainter methodsFor:'user interaction - dialog'!
checkClassAndSelector
"check for class & superclass"
|superclass cls|
specClass isNil ifTrue:[^ false].
specClass isBehavior ifFalse:[
cls := Smalltalk at:specClass asSymbol
] ifTrue:[
cls := specClass
].
cls isNil ifTrue:[
(superclass := Smalltalk at:specSuperclass asSymbol) isNil ifTrue:[
self warn:'no class named ' , specSuperclass , ' exists.'.
^ false.
].
(self confirm:'create ' , specClass , ' ?') ifTrue:[
superclass subclass:(specClass asSymbol)
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'New-Applications'.
^ true.
].
^ false.
].
cls isBehavior ifFalse:[
self warn:'a global named ' , specClass , ' exists, but is no class.'.
^ false.
].
specSuperclass isBehavior ifFalse:[
specSuperclass isEmpty ifFalse:[
superclass := Smalltalk at:specSuperclass asSymbol
] ifTrue:[
specSuperclass := nil.
]
] ifTrue:[
superclass := specSuperclass
].
specSuperclass notNil ifTrue:[
superclass isNil ifTrue:[
self warn:'no class named ' , specSuperclass , ' exists.'.
^ false.
].
(cls isSubclassOf:superclass) ifFalse:[
self information:('a global named ' , specClass , ' exists,\' ,
'but is not a subclass of ' , superclass name , '.\\' ,
'Check and try again if that is not what you want.') withCRs.
]
].
superclass isNil ifTrue:[
cls notNil ifTrue:[
specSuperclass := cls superclass name
]
].
^ true
"Modified: 25.6.1997 / 13:37:11 / cg"
!
defineClassAndSelector
"launch a dialog to define class, superclass and method"
|again tmp|
[
again := false.
(tmp := specClass) isNil ifTrue:[tmp := 'NewApplication'].
aspects at:#classNameChannel put:tmp asValue.
(tmp := specSelector) isNil ifTrue:[tmp := 'windowSpec'].
aspects at:#methodNameChannel put:tmp asValue.
(tmp := specSuperclass) isNil ifTrue:[tmp := 'ApplicationModel'].
aspects at:#superclassNameChannel put:tmp asValue.
(self openDialogInterface:#nameAndSelectorSpec) ifTrue:[
specClass := (self aspectFor:#classNameChannel) value.
specSelector := (self aspectFor:#methodNameChannel) value.
specSelector notNil ifTrue:[specSelector := specSelector asSymbol].
specSuperclass := (self aspectFor:#superclassNameChannel) value.
(again := self checkClassAndSelector not) ifFalse:[
self painter className:specClass
superclassName:specSuperclass
selector:specSelector.
]
]
] doWhile:[again]
"Modified: 17.6.1997 / 14:42:02 / cg"
! !
!UIPainter methodsFor:'user interaction - move'!
doStepDown
treeView doStepOver:1
!
doStepIn
treeView doStepIn
!
doStepOut
treeView doStepOut
!
doStepUp
treeView doStepOver:-1
! !
!UIPainter methodsFor:'user interaction - pullDown'!
doBrowseAppClass
"open a browser on the class"
|cls|
self painter isModified ifTrue:[
self warn:'the change have not yet been reinstalled.\\The browser will show the old interfaces code.' withCRs.
].
specClass isNil ifTrue:[
^ self information:'no class yet'.
].
specClass isBehavior ifFalse:[
cls := Smalltalk at:specClass asSymbol
] ifTrue:[
cls := specClass
].
cls isNil ifTrue:[
^ self information:'no class yet'.
].
SystemBrowser openInClass:cls
"Modified: 28.7.1997 / 18:30:13 / cg"
!
doFromClass
|className methodName cls sel accepted failed spec s painter|
self painter isModified ifTrue:[
(self confirm:'edit another interface without saving your modifications ?') ifFalse:[
^ self
]
].
className := (specClass ? '') asValue.
methodName := (specSelector ? '') asValue.
painter := self painter.
(s := painter className) notNil ifTrue:[
className value:s
].
(s := painter methodName) notNil ifTrue:[
methodName value:s
].
failed := false.
[
accepted :=
(DialogBox new
addTextLabel:'Classes name:';
addInputFieldOn:className;
addVerticalSpace;
addTextLabel:'methods name:';
addInputFieldOn:methodName;
addAbortButton;
addOkButton;
open
) accepted.
accepted ifTrue:[
cls := Smalltalk classNamed:className value.
cls isNil ifTrue:[
failed := true.
self warn:'no such class'.
] ifFalse:[
sel := methodName value asSymbol.
(cls respondsTo:sel ) ifFalse:[
failed := true.
self warn:'no such method'
] ifTrue:[
spec := cls perform:sel.
spec isArray ifFalse:[
failed := true.
self warn:'not a windowSpec method'
].
"/ ok, got it
self setClass:cls selector:sel.
painter setupFromSpec:spec.
^ self
]
]
]
] doWhile:[accepted and:[failed]].
"Modified: 24.6.1997 / 18:59:29 / cg"
!
doInstallAspects
|code|
self hasSpecClassAndSelector ifFalse:[
self defineClassAndSelector
].
self checkClassAndSelector ifFalse:[
^ self
].
self painter className:specClass
superclassName:specSuperclass
selector:specSelector.
code := self painter generateAspectMethods.
(ReadStream on:code) fileIn.
!
doInstallHelp
"install help text
"
activeHelpTool notNil ifTrue:[
activeHelpTool installHelpSpecInto:specClass
] ifFalse:[
self information:'no help text defined'
]
!
doInstallSpec
|code painter|
self hasSpecClassAndSelector ifFalse:[
self defineClassAndSelector
].
self checkClassAndSelector ifFalse:[
^ self
].
painter := self painter.
painter className:specClass
superclassName:specSuperclass
selector:specSelector.
code := painter generateWindowSpecMethodSource withCRs.
painter resetModification.
(ReadStream on:code) fileIn.
!
doNew
self painter isModified ifTrue:[
(self confirm:'edit a new interface without saving your modifications ?') ifFalse:[
^ self
]
].
self removeAll
"Modified: 28.7.1997 / 18:28:02 / cg"
!
doPickAView
|painter view cls spec|
self painter isModified ifTrue:[
(self confirm:'pick another interface without saving your modifications ?') ifFalse:[
^ self
]
].
(view := Screen current viewFromUser) notNil ifTrue:[
view == Screen current rootView ifFalse:[
painter := self painter.
spec := UISpecification fromView:view topView.
"/ ok, got it
view application notNil ifTrue:[
cls := view application class
] ifFalse:[
cls := view class
].
self setClass:cls selector:nil.
painter setupFromSpec:spec.
]
]
"Modified: 24.6.1997 / 19:02:57 / cg"
!
doStartApplication
|cls|
self painter isModified ifTrue:[
(self confirm:'the changed spec has not yet been reinstalled.\\Start anyway (based upon the previous interface) ?' withCRs) ifFalse:[
^ self
]
].
(specClass isNil or:[specSelector size < 2]) ifTrue:[
^ self information:'no class or selector defined'.
].
specClass isBehavior ifFalse:[
cls := Smalltalk at:specClass asSymbol
] ifTrue:[
cls := specClass
].
cls isNil ifTrue:[
^ self information:'class not existant'.
].
(cls respondsTo:specSelector) ifFalse:[
^ self information:('no method for: #'
, specSelector , ' in ' , cls name ,
'\\(did you install the spec ?)') withCRs.
].
cls new openInterface:specSelector
"Modified: 28.7.1997 / 18:30:25 / cg"
!
doWindowSpec
|code v|
code := self painter generateWindowSpecMethodSource.
v := CodeView open.
v contents:code.
v label:'windowSpec'.
! !
!UIPainter::TreeView class methodsFor:'constants'!
imageMasterChild
ImageMasterChild isNil ifTrue:[
ImageMasterChild := Image fromFile:('xpmBitmaps/document_images/tiny_file_plain_gray.xpm').
].
^ ImageMasterChild
"
ImageMasterChild := nil
"
"Modified: 28.7.1997 / 11:55:22 / cg"
!
imageMasterParent
ImageMasterParent isNil ifTrue:[
"/ ImageMasterParent := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_locked.xpm').
ImageMasterParent := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_gray.xpm').
].
^ ImageMasterParent
"
ImageMasterParent := nil
"
"Modified: 28.7.1997 / 11:56:29 / cg"
! !
!UIPainter::TreeView class methodsFor:'documentation'!
documentation
"
selection in tree view; only used by the UIPainter
[see also:]
SelectionInTreeView
SelectionInTree
TreeItem
UIPainter
[author:]
Claus Atzkern
"
! !
!UIPainter::TreeView methodsFor:'accessing'!
canvas
"returns the canvas( UIPainter )
"
^ model root contents view
!
canvas:aCanvas
"install canvas( UIPainter )
"
|props|
props := UIPainterView::ViewProperty new.
props view:aCanvas.
model root:(TreeItem name:'Canvas' contents:props).
model root expand.
self enableChannel:(aCanvas enableChannel).
! !
!UIPainter::TreeView methodsFor:'accessing property'!
propertiesDo:aOneArgBlock
"evaluate the argument a block on each property
"
self allItemsDo:[:anItem| aOneArgBlock value:(anItem contents)]
!
propertyDetect:aOneArgBlock
"evaluate the block on each property
"
self allItemsDo:[:anItem|
(aOneArgBlock value:(anItem contents)) ifTrue:[^ anItem contents]
].
^ nil
!
propertySelected
"returns current selected property or nil in case of multi selection
or empty selection
"
|idx|
selection size == 1 ifTrue:[
(idx := selection first) ~~ 1 ifTrue:[ "canvas: not yet supported"
^ (listOfNodes at:idx) contents
]
].
^ nil
! !
!UIPainter::TreeView methodsFor:'adding & removing'!
addProperty:aProperty
"add a new item
"
|prnt child canvas view|
child := TreeItem name:(aProperty name) contents:aProperty.
view := aProperty view.
canvas := self canvas.
[ ((view := view superView) notNil and:[(prnt := self itemOfView:view) isNil])
] whileTrue.
prnt isNil ifTrue:[
prnt := model root
].
model add:child below:prnt.
!
removeAll
"remove all items other than canvas
"
lastDrawnMaster := nil.
self canvas subViews copy do:[:aView|
(aView isKindOf:InputView) ifFalse:[aView destroy]
].
model root children:(OrderedCollection new).
model recomputeList.
self selection:nil.
!
removeView:aView
"remove a view
"
|item spv|
item := self itemOfView:aView.
item notNil ifTrue:[
spv := aView superView.
aView destroy.
spv sizeChanged:nil.
model remove:item
]
! !
!UIPainter::TreeView methodsFor:'canvas selection'!
cvsSelection:aSelection
"canvas changed its selection
"
|sel list rcLt|
list := OrderedCollection new.
aSelection isNil ifFalse:[
aSelection isCollection ifTrue:[
aSelection notNil ifTrue:[sel := aSelection]
] ifFalse:[
sel := Array with:aSelection
]
].
sel notNil ifTrue:[
rcLt := false.
sel do:[:aView||item|
(item := self itemOfView:aView) notNil ifTrue:[
list add:item.
[(item := item parent) notNil] whileTrue:[
item hidden ifTrue:[
rcLt := true.
item expand.
]
]
]
].
rcLt ifTrue:[model recomputeList].
sel := list collect:[:anItem| listOfNodes findFirst:[:el| el == anItem]]
] ifFalse:[
sel := list
].
self cvsEventsDisabledDo:[ self selection:sel ].
!
cvsSelectionAdd:aView
"canvas adds a view to current selection
"
|parent item rcLt oldSel|
item := self itemOfView:aView.
item notNil ifTrue:[
parent := item.
[ (parent := parent parent) notNil ] whileTrue:[
parent hidden ifTrue:[
rcLt := true.
parent expand.
]
].
rcLt == true ifTrue:[model recomputeList].
oldSel := selection copy.
self addToSelection:(listOfNodes findFirst:[:el| el == item]).
self selectionChangedFrom:oldSel
].
!
cvsSelectionRemove:aView
"canvas removes a view from current selection
"
|parent item rcLt oldSel|
item := self itemOfView:aView.
item notNil ifTrue:[
parent := item.
[ (parent := parent parent) notNil ] whileTrue:[
parent hidden ifTrue:[
rcLt := true.
parent expand.
]
].
rcLt == true ifTrue:[model recomputeList].
oldSel := selection copy.
self removeFromSelection:(listOfNodes findFirst:[:el| el == item]).
self selectionChangedFrom:oldSel
].
! !
!UIPainter::TreeView methodsFor:'change & update'!
layoutChanged
"layout of any component changed; in case of single selection, the
application will be informed to update its layout
"
selection size == 1 ifTrue:[
self application layoutChanged
]
!
propertyChanged:aProperty
"property of view derived from argument a property changed
"
|item idx end|
item := self itemOfView:(aProperty view).
item notNil ifTrue:[
item contents:aProperty.
item name = aProperty name ifFalse:[
idx := self firstLineShown.
(end := self lastLineShown) > listOfNodes size ifTrue:[
end := listOfNodes size
].
item name:aProperty name.
[idx <= end] whileTrue:[
(listOfNodes at:idx) == item ifTrue:[
self redrawLine:idx. "/ is visible; redraw line
end := 0
] ifFalse:[
idx := idx + 1
]
]
].
self selectedNode == item ifTrue:[ "/ inform application
self application propertyChanged
]
].
! !
!UIPainter::TreeView methodsFor:'drag & drop'!
canDrop:anObjectOrCollection
"can drop ? delegate to canvas
"
^ self canvas canDrop:anObjectOrCollection
!
drop:anObjectOrCollection at:aPoint
"drop objects ? delegate to canvas
"
self canvas drop:anObjectOrCollection at:aPoint
! !
!UIPainter::TreeView methodsFor:'event processing'!
cvsEventsDisabledDo:aBlock
"evaluate the block without raising selection changed notifications
to canvas
"
|restoreCvsEvents|
restoreCvsEvents := cvsEventsDisabled.
cvsEventsDisabled := true.
aBlock value.
cvsEventsDisabled := restoreCvsEvents.
!
cvsSetupListDo:aBlock
"evaluate block without handling notifications from model; after evaluation
the new list will be recomputed
"
model removeDependent:self.
self cvsEventsDisabledDo:[
self selection:nil.
aBlock value
].
model addDependent:self.
model recomputeList.
!
doubleClicked
"disable collapse of canvas item
"
self selectedNode == model root ifFalse:[
super doubleClicked
]
! !
!UIPainter::TreeView methodsFor:'initialization'!
initialize
"initialization; set multiple select and model
"
super initialize.
self multipleSelectOk:true.
self model:(SelectionInTree new).
cvsEventsDisabled := false.
! !
!UIPainter::TreeView methodsFor:'private'!
allItemsDo:aOneArgBlock
"evaluate the argument a block on each item other than the canvas
"
model root allChildrenDo:aOneArgBlock
!
figureFor:aNode
"returns image for an item; testing whether item is the first
entry into the selection
"
|master|
selection size == 0 ifFalse:[
master := listOfNodes at:(selection first).
aNode == master ifTrue:[
lastDrawnMaster := master.
aNode children size == 0 ifTrue:[
imageMasterChild isNil ifTrue:[
imageMasterChild := (self class imageMasterChild) onDevice:device.
].
^ imageMasterChild
].
imageMasterParent isNil ifTrue:[
imageMasterParent := (self class imageMasterParent) onDevice:device.
].
^ imageMasterParent
]
].
^ super figureFor:aNode
!
itemOfView:aView
"returns item assigned to view or nil
"
aView notNil ifTrue:[
self allItemsDo:[:anItem|
(anItem contents view == aView) ifTrue:[^ anItem]
]
].
^ nil
!
selectionChangedFrom:oldSelection
"selection has changed. update master selection and raise notification
to canvas in case of enabled cvs events
"
|sel|
super selectionChangedFrom:oldSelection.
cvsEventsDisabled ifFalse:[
selection notNil ifTrue:[
sel := selection collect:[:i| (listOfNodes at:i) contents view].
] ifFalse:[
sel := #()
].
self canvas updateSelectionFromModel:sel.
].
selection size ~~ 0 ifTrue:[
sel := selection first.
(listOfNodes at:sel) == lastDrawnMaster ifFalse:[
self redrawLine:sel
]
]
! !
!UIPainter::TreeView methodsFor:'queries'!
canStepIn
"returns true if can step in
"
|item prnt|
( (item := self selectedNode) isNil
or:[(prnt := item parent) isNil
or:[(prnt := prnt childAt:((prnt indexOfChild:item) + 1)) isNil
or:[prnt contents spec class supportsSubComponents not]]]
) ifTrue:[
^ false
].
^ true
!
canStepOut
|item prnt|
( (item := self selectedNode) isNil
or:[(prnt := item parent) isNil
or:[prnt parent isNil]]
) ifTrue:[
^ false
].
^ true
!
hasValidSelection
"returns true if any selection exists other than root
"
|size|
(size := selection size) > 1 ifFalse:[
(size == 0 or:[self isInSelection:1]) ifTrue:[
^ false
]
].
^ true
! !
!UIPainter::TreeView methodsFor:'user interactions'!
doStepIn
|item prnt canvas|
( (item := self selectedNode) isNil
or:[(prnt := item parent) isNil
or:[(prnt := prnt childAt:((prnt indexOfChild:item) + 1)) isNil
or:[prnt contents spec class supportsSubComponents not]]]
) ifFalse:[
canvas := self canvas.
canvas deleteSelection.
canvas setSelection:(prnt contents view) withRedraw:false.
canvas pasteWithLayout.
]
!
doStepOut
|item next prnt canvas|
( (item := self selectedNode) isNil
or:[(prnt := item parent) isNil
or:[(next := prnt parent) isNil]]
) ifTrue:[
^ self
].
model removeDependent:self.
canvas := self canvas.
canvas deleteSelection.
canvas setSelection:(next contents view) withRedraw:false.
canvas pasteWithLayout.
!
doStepOver:anIndex
"move child 'anOffset' forward or backward in list of children
"
|item idx size prnt spVw view|
( (item := self selectedNode) isNil
or:[(prnt := item parent) isNil
or:[(size := prnt children size) < 2]]
) ifFalse:[
idx := prnt indexOfChild:item.
model removeDependent:self.
model removeSelection.
selection := nil.
model addDependent:self.
idx := idx + anIndex.
idx < 1 ifTrue:[idx := size]
ifFalse:[idx > size ifTrue:[idx := 1]].
model add:item beforeIndex:idx below:prnt.
idx := prnt indexOfChild:item.
view := item contents view.
spVw := view superView.
"/ input view might by contained in sequence
((size := self canvas findInputViewIn:spVw) ~~ 0 and:[idx >= size]) ifTrue:[
idx := idx + 1
].
spVw changeSequenceOrderFor:view to:idx.
spVw specClass isLayoutContainer ifFalse:[
spVw subViews do:[:v| v raise ].
self canvas inputView raise
].
self selectNode:item.
]
! !
!UIPainter class methodsFor:'documentation'!
version
^ '$Header$'
! !