--- a/UIPainter.st Mon Feb 17 18:23:19 1997 +0100
+++ b/UIPainter.st Tue Feb 18 11:38:57 1997 +0100
@@ -14,11 +14,11 @@
instanceVariableNames:'menu nameField elementMenu workView treeView outletView stringBox
actionBox listBox fileBox currentFileName topView propertyFrame
whichProperty changeSelectorHolder changeChannel
- aspectSelectorHolder aspectChannel nameChannel fgChannel
- bgChannel applyAction leftFractionHolder leftOffsetHolder
- rightFractionHolder rightOffsetHolder topFractionHolder
- topOffsetHolder bottomFractionHolder bottomOffsetHolder specClass
- specSelector leftAlignmentFractionHolder
+ aspectSelectorHolder aspectChannel nameChannel applyAction
+ leftFractionHolder leftOffsetHolder rightFractionHolder
+ rightOffsetHolder topFractionHolder topOffsetHolder
+ bottomFractionHolder bottomOffsetHolder specClass specSelector
+ specSuperclass leftAlignmentFractionHolder
topAlignmentFractionHolder classNameHolder methodNameHolder
aspectHolders propertyShown specShown'
classVariableNames:''
@@ -187,10 +187,16 @@
#(#InputFieldSpec
#'layout:' #(#LayoutFrame 0 0 49 0 163 0 69 0)
#model: #foregroundChannel
+ #acceptOnLostFocus: true
+ #tabable: true
+
)
#(#InputFieldSpec
#'layout:' #(#LayoutFrame 0 0 119 0 163 0 142 0)
#model: #backgroundChannel
+ #acceptOnLostFocus: true
+ #tabable: true
+
)
)
)
@@ -202,6 +208,8 @@
#'layout:' #(#LayoutFrame 102 0 246 0 153 0 272 0)
#'label:' 'apply'
#'model:' #setColors
+ #tabable: true
+
)
)
)
@@ -938,13 +946,13 @@
#'name:' 'button1'
#'layout:' #(#LayoutFrame 30 0 250 0 129 0 279 0)
#'label:' 'cancel'
- #'model:' #cancelClicked
+ #'model:' #cancel
)
#(#ActionButtonSpec
#'name:' 'button2'
#'layout:' #(#LayoutFrame 160 0 250 0 259 0 279 0)
#'label:' 'ok'
- #'model:' #okClicked
+ #'model:' #accept
)
)
)
@@ -1024,6 +1032,7 @@
nameChannel value:singleSelection name.
self fetchLayoutFrom:singleSelection.
+ self fetchColorsFrom:singleSelection.
self fetchModelAspectsFrom:singleSelection.
].
^ self
@@ -1037,7 +1046,7 @@
!
backgroundChannel
- ^ bgChannel
+ ^ self aspectFor:#backgroundChannel
!
bottomFractionChannel
@@ -1050,7 +1059,8 @@
!
foregroundChannel
- ^ fgChannel
+ ^ self aspectFor:#foregroundChannel
+
!
leftAlignmentFractionChannel
@@ -1152,28 +1162,22 @@
nil selectors are taken as separators (see setupButtonPanel)"
^ #(
- #(alignSelectionLeft true 'b_alignL.xbm' nil false)
- #(alignSelectionRight true 'b_alignR.xbm' nil false)
- #(alignSelectionLeftAndRight true 'b_alignLR.xbm' nil false)
- #(nil nil nil nil)
- #(alignSelectionTop true 'b_alignT.xbm' nil false)
- #(alignSelectionBottom true 'b_alignB.xbm' nil false)
- #(alignSelectionTopAndBottom true 'b_alignTB.xbm' nil false)
- #(nil nil nil nil)
- #(alignSelectionCenterHor true 'b_alignCH.xbm' nil false)
- #(alignSelectionCenterVer true 'b_alignCV.xbm' nil false)
- #(nil nil nil nil)
- #(moveSelectionLeft true 'b_moveLeft.xbm' nil true)
- #(moveSelectionRight true 'b_moveRight.xbm' nil true)
- #(moveSelectionUp true 'b_moveUp.xbm' nil true)
- #(moveSelectionDown true 'b_moveDown.xbm' nil true)
- #(moveSelectionLeft10 true 'b_moveLeft2.xbm' nil true)
- #(moveSelectionRight10 true 'b_moveRight2.xbm' nil true)
- #(moveSelectionUp10 true 'b_moveUp2.xbm' nil true)
- #(moveSelectionDown10 true 'b_moveDown2.xbm' nil true)
- )
-
- "Modified: 5.9.1995 / 22:20:36 / claus"
+ #( alignSelectionLeft 'b_alignL.xbm' )
+ #( alignSelectionRight 'b_alignR.xbm' )
+ #( alignSelectionLeftAndRight 'b_alignLR.xbm' )
+ #( nil )
+ #( alignSelectionTop 'b_alignT.xbm' )
+ #( alignSelectionBottom 'b_alignB.xbm' )
+ #( alignSelectionTopAndBottom 'b_alignTB.xbm' )
+ #( nil )
+ #( alignSelectionCenterHor 'b_alignCH.xbm' )
+ #( alignSelectionCenterVer 'b_alignCV.xbm' )
+ #( nil )
+ #( moveSelectionLeft: 'b_moveLeft.xbm' )
+ #( moveSelectionRight: 'b_moveRight.xbm' )
+ #( moveSelectionUp: 'b_moveUp.xbm' )
+ #( moveSelectionDown: 'b_moveDown.xbm' )
+ )
!
createCanvas
@@ -1184,6 +1188,7 @@
topView := StandardSystemView new.
topView label:'unnamed'.
topView extent:300@300.
+ topView application:self.
workView := UIPainterView in:topView.
workView layout:(0.0 @ 0.0 corner:1.0 @ 1.0) asLayout.
@@ -1219,7 +1224,7 @@
aspectHolders at:#classNameChannel put:((specClass notNil ifTrue:[specClass name] ifFalse:['NewApplication']) asValue).
aspectHolders at:#superclassNameChannel put:((specClass notNil ifTrue:[specClass superclass] ifFalse:[ApplicationModel]) name asValue).
- aspectHolders at:#methodNameChannel put:(specSelector asValue).
+ aspectHolders at:#methodNameChannel put:((specSelector notNil ifTrue:[specSelector] ifFalse:[#windowSpec]) asValue).
aspectHolders at:#aspectChannel put:(ValueHolder new).
aspectHolders at:#changeChannel put:(ValueHolder new).
@@ -1250,7 +1255,6 @@
'dimension'
'special'
'code'
- 'debug'
'test'
)).
@@ -1267,15 +1271,15 @@
menu at:#file
putLabels:(resources array:
#('new'
- 'from class'
+ 'from class ...'
'pick a view '
'-'
'save'
'save as ...'
'-'
- 'compile'
+ 'install'
'-'
- 'source'
+"/ 'source'
'windowSpec'
'inspect me'
'-'
@@ -1290,9 +1294,9 @@
doSave
doSaveAs
nil
- doCompile
+ doInstall
nil
- doSource
+"/ doSource
doWindowSpec
inspect
nil
@@ -1509,6 +1513,7 @@
|specArray|
specClass := aClass.
+ specSuperclass := aClass superclass.
specSelector := aSelector.
self openInterface.
@@ -1526,54 +1531,65 @@
!
setupButtonPanelIn:aTopView below:aMenu
- "create the buttonPanel"
-
- |spc mh buttonPanel|
+ "create the buttonPanel
+ "
+ |spc mh buttonPanel pressAction|
spc := View viewSpacing // 2.
buttonPanel := HorizontalPanelView in:aTopView.
buttonPanel level:-1; borderWidth:0.
buttonPanel horizontalLayout:#leftSpace.
- self buttonPanelSpec do:[:entry |
- |sel toCanvas imgFile label b sep autoRepeat|
+ pressAction := [:aButton :aSelector|
+ |menu org top|
+
+ workView selection notNil ifTrue:[
+ top := aButton topView.
+
+ org := top origin + (aButton originRelativeTo:top)
+ + (0@((spc + aButton extent y))).
+
+ menu := PopUpMenu labels:#( '1' '2' '4' '10' '..' )
+ args:#( 1 2 4 10 nil ).
- sel := entry at:1.
- sel isNil ifTrue:[
- sep := View in:buttonPanel.
- sep extent:20@1; borderWidth:0.
- ] ifFalse:[
- toCanvas := entry at:2.
- imgFile := entry at:3.
- label := entry at:4.
- autoRepeat := entry at:5.
- b := Button in:buttonPanel.
- autoRepeat ifTrue:[
- b autoRepeat:autoRepeat.
- b controller beTriggerOnDown.
- ].
- imgFile notNil ifTrue:[
- b logo:(Image fromFile:imgFile).
- ] ifFalse:[
- b logo:label
- ].
- toCanvas ifTrue:[
- b model:workView
- ] ifFalse:[
- b model:self
- ].
- b changeMessage:sel
- ]
+ menu action:[:anArg||no|
+ (no := anArg) isNil ifTrue:[
+ no := EnterBox request:'number'.
+ no := SmallInteger readFrom:no onError:0.
+ ].
+ no ~~ 0 ifTrue:[
+ workView perform:aSelector with:no
+ ]
+ ].
+ menu showAt:org.
+ ].
+ aButton turnOff
+ ].
+
+ self buttonPanelSpec do:[:anArray| |selector image button|
+ selector := anArray at:1.
+
+ selector notNil ifTrue:[
+ image := Image fromFile:( anArray at:2 ).
+ button := Button label:image in:buttonPanel.
+
+ selector last == $: ifFalse:[
+ button action:[ workView perform:selector ]
+ ] ifTrue:[
+ button pressAction:[ pressAction value:button value:selector ]
+ ]
+ ] ifFalse:[|sep|
+ sep := View in:buttonPanel.
+ sep extent:20@1; borderWidth:0.
+ ]
].
mh := aMenu height.
buttonPanel origin:0.0 @ (mh + spc)
- corner:(1.0 @ (mh + spc + buttonPanel preferredExtent y)).
+ corner:(1.0 @ (mh + spc + buttonPanel preferredExtent y)).
buttonPanel leftInset:spc; rightInset:spc.
- ^ buttonPanel
-
- "Modified: 5.9.1995 / 22:23:13 / claus"
+ ^ buttonPanel
! !
!UIPainter methodsFor:'misc'!
@@ -1784,6 +1800,24 @@
!UIPainter methodsFor:'private - fetch'!
+fetchColorsFrom:aView
+ |holder|
+
+ holder := self aspectFor:#foregroundChannel.
+ (aView respondsTo:#foregroundColor) ifTrue:[
+ holder value:(aView foregroundColor storeString).
+ ] ifFalse:[
+ holder value:nil
+ ].
+ holder := self aspectFor:#backgroundChannel.
+ (aView respondsTo:#backgroundColor) ifTrue:[
+ holder value:(aView backgroundColor storeString).
+ ] ifFalse:[
+ holder value:nil
+ ].
+
+!
+
fetchLayoutFrom:aView
|layout extent|
@@ -2032,164 +2066,12 @@
super closeRequest
!
-doCompile
- |code|
-
- code := workView generateCode.
- (ReadStream on:code) fileIn.
-
- "Modified: 4.9.1995 / 17:06:10 / claus"
-!
-
-doFinish
- self closeRequest
-!
-
-doFromClass
- |className methodName cls sel accepted failed spec s|
-
- className := '' asValue.
- methodName := '' asValue.
- (s := workView className) notNil ifTrue:[
- className value:s
- ].
- (s := workView 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
- workView className:className value.
- workView methodName:methodName value.
- workView setupFromSpec:spec.
- ^ self
- ]
- ]
- ]
- ] doWhile:[accepted and:[failed]].
-
- "Modified: 5.9.1995 / 18:47:57 / claus"
-!
-
-doNew
- workView removeAll.
- ^ self
-
- "Modified: 5.9.1995 / 20:52:21 / claus"
-!
-
-doOpen
- fileBox isNil ifTrue:[
- fileBox := FileSelectionBox
- title:''
- "pattern:'*.sib'"
- okText:''
- abortText:(Resource name:'BUILDER_ABORT_LABEL'
- fromFile:'Builder.rs')
- action:[nil]
+closeRequestFor:aTopView
+ aTopView ~~ topView ifTrue:[
+ topView device beep.
+ ^ self
].
- fileBox title:(Resource name:'BUILDER_OPEN_TITLE' fromFile:'Builder.rs').
- fileBox action:[:fileName | self openFile:fileName].
- fileBox okText:(Resource name:'BUILDER_OPEN_OK_LABEL' fromFile:'Builder.rs').
- fileBox showAtPointer
-!
-
-doPickAView
- |view className methodName cls sel accepted spec s|
-
- view := Display viewFromUser.
- view isNil ifTrue:[^ self].
-
- spec := UISpecification fromView:view topView.
-
- "/ ok, got it
- workView setupFromSpec:spec.
- workView className:view class name.
- workView methodName:#newSpec.
- ^ self
-
- "Modified: 5.9.1995 / 23:25:53 / claus"
-!
-
-doPrint
- ^ self
-!
-
-doSave
- currentFileName notNil ifTrue:[
- self saveAs:currentFileName
- ] ifFalse:[
- self doSaveAs
- ]
-!
-
-doSaveAs
- fileBox isNil ifTrue:[
- fileBox := FileSelectionBox
- title:''
- "pattern:'*.draw'"
- okText:''
- abortText:(Resource name:'BUILDER_ABORT_LABEL'
- fromFile:'Builder.rs')
- action:[nil]
- ].
- fileBox title:(Resource name:'BUILDER_SAVE_TITLE' fromFile:'Builder.rs').
- fileBox action:[:fileName | self saveAs:fileName].
- fileBox okText:(Resource name:'BUILDER_SAVE_OK_LABEL' fromFile:'Builder.rs').
- fileBox showAtPointer
-!
-
-doSource
- |code v|
-
- code := workView generateCode.
- v := CodeView open.
- v contents:code.
- v label:(workView applicationName).
- ^ self
-
- "Modified: 5.9.1995 / 21:02:05 / claus"
-!
-
-doWindowSpec
- |code v|
-
- code := workView generateWindowSpec.
- v := CodeView open.
- v contents:code.
- v label:'windowSpec'.
- ^ self
-
- "Modified: 5.9.1995 / 21:04:14 / claus"
+ super closeRequestFor:aTopView
!
propertySelectionChanged
@@ -2506,22 +2388,18 @@
setColors
|fg bg|
- fg := fgChannel value.
+ fg := self foregroundChannel value.
(fg notNil and:[fg notEmpty]) ifTrue:[
fg := Color readFrom:fg.
workView singleSelectionDo:[:selectedView |
- selectedView ~~ workView ifTrue:[
- selectedView foregroundColor:fg
- ].
+ selectedView foregroundColor:fg
].
].
- bg := bgChannel value.
+ bg := self backgroundChannel value.
(bg notNil and:[bg notEmpty]) ifTrue:[
bg := Color readFrom:bg.
workView singleSelectionDo:[:selectedView |
- selectedView ~~ workView ifTrue:[
- selectedView backgroundColor:bg
- ].
+ selectedView backgroundColor:bg
].
].
!
@@ -2670,6 +2548,245 @@
outletView := nil.
specShown := nil.
+! !
+
+!UIPainter methodsFor:'user interaction - dialogs'!
+
+checkClassAndSelector
+ "check for class & superclass"
+
+ |superclass cls|
+
+ (cls := Smalltalk at:specClass asSymbol) 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 notNil ifTrue:[
+ (superclass := Smalltalk at:specSuperclass asSymbol) isNil ifTrue:[
+ self warn:'no class named ' , specSuperclass , ' exists.'.
+ ^ false.
+ ].
+
+ (cls isSubclassOf:superclass) ifFalse:[
+ self warn:'a global named ' , specClass , ' exists, but is not a subclass of ' , superclass name , '.'.
+ ^ false.
+ ]
+ ].
+ ^ true
+!
+
+defineClassAndSelector
+ "launch a dialog to define class, superclass and method"
+
+ |again|
+
+ [
+ again := false.
+ (self openDialogInterface:#nameAndSelectorSpec) ifTrue:[
+
+ specClass := (self aspectFor:#classNameChannel) value.
+ specSelector := (self aspectFor:#methodNameChannel) value.
+ specSuperclass := (self aspectFor:#superclassNameChannel) value.
+
+ again := self checkClassAndSelector not.
+ again ifFalse:[
+ workView className:specClass superclassName:specSuperclass selector:specSelector.
+ ].
+ ]
+ ] doWhile:[again]
+
+! !
+
+!UIPainter methodsFor:'user interaction - menu'!
+
+doFinish
+ self closeRequest
+!
+
+doFromClass
+ |className methodName cls sel accepted failed spec s|
+
+ className := '' asValue.
+ methodName := '' asValue.
+ (s := workView className) notNil ifTrue:[
+ className value:s
+ ].
+ (s := workView 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
+ workView className:className value.
+ workView methodName:methodName value.
+ workView setupFromSpec:spec.
+ ^ self
+ ]
+ ]
+ ]
+ ] doWhile:[accepted and:[failed]].
+
+ "Modified: 5.9.1995 / 18:47:57 / claus"
+!
+
+doInstall
+ |code|
+
+ (specClass isNil or:[specSelector isNil]) ifTrue:[
+ self defineClassAndSelector
+ ].
+
+ self checkClassAndSelector ifFalse:[
+ ^ self
+ ].
+
+ workView className:specClass superclassName:specSuperclass selector:specSelector.
+
+ code := workView generateCode.
+ (ReadStream on:code) fileIn.
+
+ "Modified: 4.9.1995 / 17:06:10 / claus"
+!
+
+doNew
+ workView removeAll.
+ ^ self
+
+ "Modified: 5.9.1995 / 20:52:21 / claus"
+!
+
+doOpen
+ fileBox isNil ifTrue:[
+ fileBox := FileSelectionBox
+ title:''
+ "pattern:'*.sib'"
+ okText:''
+ abortText:(Resource name:'BUILDER_ABORT_LABEL'
+ fromFile:'Builder.rs')
+ action:[nil]
+ ].
+ fileBox title:(Resource name:'BUILDER_OPEN_TITLE' fromFile:'Builder.rs').
+ fileBox action:[:fileName | self openFile:fileName].
+ fileBox okText:(Resource name:'BUILDER_OPEN_OK_LABEL' fromFile:'Builder.rs').
+ fileBox showAtPointer
+!
+
+doPickAView
+ |view className methodName cls sel accepted spec s|
+
+ view := Display viewFromUser.
+ view isNil ifTrue:[^ self].
+
+ spec := UISpecification fromView:view topView.
+
+ "/ ok, got it
+ workView setupFromSpec:spec.
+ workView className:view class name.
+ workView methodName:#newSpec.
+ ^ self
+
+ "Modified: 5.9.1995 / 23:25:53 / claus"
+!
+
+doPrint
+ ^ self
+!
+
+doSave
+ currentFileName notNil ifTrue:[
+ self saveAs:currentFileName
+ ] ifFalse:[
+ self doSaveAs
+ ]
+!
+
+doSaveAs
+ fileBox isNil ifTrue:[
+ fileBox := FileSelectionBox
+ title:''
+ "pattern:'*.draw'"
+ okText:''
+ abortText:(Resource name:'BUILDER_ABORT_LABEL'
+ fromFile:'Builder.rs')
+ action:[nil]
+ ].
+ fileBox title:(Resource name:'BUILDER_SAVE_TITLE' fromFile:'Builder.rs').
+ fileBox action:[:fileName | self saveAs:fileName].
+ fileBox okText:(Resource name:'BUILDER_SAVE_OK_LABEL' fromFile:'Builder.rs').
+ fileBox showAtPointer
+! !
+
+!UIPainter ignoredMethodsFor:'user interaction - menu'!
+
+doSource
+ |code v|
+
+ code := workView generateCode.
+ v := CodeView open.
+ v contents:code.
+ v label:(workView applicationName).
+ ^ self
+
+ "Modified: 5.9.1995 / 21:02:05 / claus"
+! !
+
+!UIPainter methodsFor:'user interaction - menu'!
+
+doWindowSpec
+ |code v|
+
+ code := workView generateWindowSpecMethodSource.
+ v := CodeView open.
+ v contents:code.
+ v label:'windowSpec'.
+ ^ self
+
+ "Modified: 5.9.1995 / 21:04:14 / claus"
!
toggleTest
@@ -2686,16 +2803,6 @@
workView testMode:t
! !
-!UIPainter methodsFor:'user interaction - dialogs'!
-
-defineClassAndSelector
- "launch a dialog to define class, superclass and method"
-
- |dialog|
-
- self openDialogInterface:#nameAndSelectorSpec.
-! !
-
!UIPainter class methodsFor:'documentation'!
version