# HG changeset patch # User ca # Date 856262337 -3600 # Node ID 19e021c8f1efe062e86f4280364b261de0bc755e # Parent d0b5a33e6df02dd15628ade97168c41fb3dd1c25 *** empty log message *** diff -r d0b5a33e6df0 -r 19e021c8f1ef UIObjectView.st --- a/UIObjectView.st Mon Feb 17 18:23:19 1997 +0100 +++ b/UIObjectView.st Tue Feb 18 11:38:57 1997 +0100 @@ -1289,72 +1289,24 @@ ! -moveSelectionDown - self moveSelectionDown:1 - - -! - -moveSelectionDown10 - self moveSelectionDown:10 - - -! - moveSelectionDown:n self basicMoveSelectionVertical:n ! -moveSelectionLeft - self moveSelectionLeft:1 - - -! - -moveSelectionLeft10 - self moveSelectionLeft:10 - - -! - moveSelectionLeft:n self basicMoveSelectionHorizontal:(n negated) ! -moveSelectionRight - self moveSelectionRight:1 - - -! - -moveSelectionRight10 - self moveSelectionRight:10 - - -! - moveSelectionRight:n self basicMoveSelectionHorizontal:n ! -moveSelectionUp - self moveSelectionUp:1 - - -! - -moveSelectionUp10 - self moveSelectionUp:10 - - -! - moveSelectionUp:n self basicMoveSelectionVertical:(n negated) diff -r d0b5a33e6df0 -r 19e021c8f1ef UIPainter.st --- 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 diff -r d0b5a33e6df0 -r 19e021c8f1ef UIPainterView.st --- a/UIPainterView.st Mon Feb 17 18:23:19 1997 +0100 +++ b/UIPainterView.st Tue Feb 18 11:38:57 1997 +0100 @@ -11,7 +11,7 @@ " UIObjectView subclass:#UIPainterView - instanceVariableNames:'fontPanel code viewProperties superclassName className methodName + instanceVariableNames:'fontPanel viewProperties superclassName className methodName categoryName' classVariableNames:'HandCursor' poolDictionaries:'' @@ -86,6 +86,13 @@ "Modified: 5.9.1995 / 18:47:17 / claus" ! +className:aClassName superclassName:aSuperclassName selector:aSelector + className := aClassName. + superclassName := aSuperclassName. + methodName := aSelector. + +! + methodName ^ methodName @@ -132,7 +139,7 @@ ! ! -!UIPainterView methodsFor:'code manipulation'! +!UIPainterView ignoredMethodsFor:'code manipulation'! changeClass |box classNameHolder superclassNameHolder| @@ -240,7 +247,7 @@ ]. ! ! -!UIPainterView methodsFor:'generating output'! +!UIPainterView ignoredMethodsFor:'generating output'! generateClassDefinition |defCode| @@ -253,21 +260,29 @@ defCode := defCode , ' category:''' , categoryName , '''\'. defCode := defCode , Character excla asString , '\\'. - code := code , (defCode withCRs) + ^ defCode withCRs -! +! ! + +!UIPainterView methodsFor:'generating output'! generateCode + "generate code for the windowSpec method" + + |code| + code := ''. - (Smalltalk classNamed:className) isNil ifTrue:[ - self generateClassDefinition. - ]. -"/ self generateInitMethod. - code := code , self generateWindowSpec. - self generateOutlets. +"/ (Smalltalk classNamed:className asSymbol) isNil ifTrue:[ +"/ code := code , self generateClassDefinition. +"/ ]. +"/ code := code , self generateInitMethod. + + code := code , self generateWindowSpecMethodSource. + +"/ code := code , self generateAspectMethods. ^ code withCRs @@ -277,10 +292,12 @@ !UIPainterView ignoredMethodsFor:'generating output'! generateInitCodeForGroup:aGroup - |c name p objects outlets moreCode sym typ val| + |code c name p objects outlets moreCode sym typ val| " := in:" + code := ''. + p := self propertyOfGroup:aGroup. name := p at:#variableName. c := ' ' , name , ' := ' , (aGroup class name) , ' new.\'. @@ -291,9 +308,9 @@ objects := p at:#controlledObjects ifAbsent:[nil]. objects notNil ifTrue:[ - objects do:[:controlledObject | - c := c , name , ' add:' , (self variableNameOf:controlledObject) , '.\' - ] + objects do:[:controlledObject | + c := c , name , ' add:' , (self variableNameOf:controlledObject) , '.\' + ] ]. code := code , c withCRs @@ -305,38 +322,43 @@ ! generateInitCodeForOtherStuff - |g c name p outlets moreCode sym typ val| + |code g c name p outlets moreCode sym typ val| + + code := ''. "generate code for groups" viewProperties do:[:props | - g := props at:#group ifAbsent:[nil]. - g notNil ifTrue:[ - self generateInitCodeForGroup:g - ] - ] + g := props at:#group ifAbsent:[nil]. + g notNil ifTrue:[ + code := code , (self generateInitCodeForGroup:g) + ] + ]. + ^ code ! generateInitCodeForView:aView - |c name p outlets moreCode sym typ val| + |code c name p outlets moreCode sym typ val| " := in:" + code := ''. + p := self propertyOfView:aView. name := p at:#variableName. c := ' ' , name , ' := ' , - (aView class name) , ' in:' , (self variableNameOf:(aView superView)) , '.\'. + (aView class name) , ' in:' , (self variableNameOf:(aView superView)) , '.\'. " origin:(...) extent:(...)" c := c , ' ' , name , ' origin:(', aView origin printString , ')' - , ' extent:(', aView extent printString , ').\'. + , ' extent:(', aView extent printString , ').\'. moreCode := p at:#initCode ifAbsent:nil. moreCode notNil ifTrue:[ - c := c , moreCode , '\' withCRs + c := c , moreCode , '\' withCRs ]. code := code , c withCRs. @@ -345,51 +367,52 @@ outlets := p at:#outlets ifAbsent:[nil]. outlets notNil ifTrue:[ - outlets do:[:selectorOutlet | - sym := selectorOutlet at:#selector. - typ := selectorOutlet at:#type. - val := selectorOutlet at:#value. - c := ' ' , name , ' ' , sym. - (typ == #number) ifTrue:[ - c := c , val printString - ]. - (typ == #string) ifTrue:[ - c := c , '''' , val , '''' - ]. - (typ == #text) ifTrue:[ - c := c , '''' , val asString , '''' - ]. - (typ == #strings) ifTrue:[ - c := c , '#( '. - val asText do:[:aString | - c := c , '''' , aString , ''' ' - ]. - c := c , ')' - ]. - (typ == #block) ifTrue:[ - c := c , val - ]. - (typ == #color) ifTrue:[ - c := c , '(Color name:''' , val , ''')' - ]. - c := c , '.' , Character cr asString. - code := code , c - ] + outlets do:[:selectorOutlet | + sym := selectorOutlet at:#selector. + typ := selectorOutlet at:#type. + val := selectorOutlet at:#value. + c := ' ' , name , ' ' , sym. + (typ == #number) ifTrue:[ + c := c , val printString + ]. + (typ == #string) ifTrue:[ + c := c , '''' , val , '''' + ]. + (typ == #text) ifTrue:[ + c := c , '''' , val asString , '''' + ]. + (typ == #strings) ifTrue:[ + c := c , '#( '. + val asText do:[:aString | + c := c , '''' , aString , ''' ' + ]. + c := c , ')' + ]. + (typ == #block) ifTrue:[ + c := c , val + ]. + (typ == #color) ifTrue:[ + c := c , '(Color name:''' , val , ''')' + ]. + c := c , '.' , Character cr asString. + code := code , c + ] ]. self subviewsOf:aView do:[:v | - self generateInitCodeForView:v - ] + code := code , (self generateInitCodeForView:v) + ]. + ^ code. "Modified: 5.9.1995 / 20:06:07 / claus" ! generateInitMethod - |defCode| + |defCode code| defCode := Character excla asString , - className , ' methodsFor:''initialization''' , - Character excla asString , '\\'. + className , ' methodsFor:''initialization''' , + Character excla asString , '\\'. defCode := defCode , 'initialize\'. defCode := defCode , ' super initialize.\'. @@ -398,13 +421,13 @@ defCode := defCode , Character excla asString , '\\'. defCode := defCode , 'setupSubViews\'. - code := code , defCode withCRs. + code := defCode withCRs. self subviewsOf:self do:[:v | - self generateInitCodeForView:v + code := code , (self generateInitCodeForView:v) ]. - self generateInitCodeForOtherStuff. + code := code , (self generateInitCodeForOtherStuff). code := code , ' ^ self\' withCRs. @@ -412,22 +435,22 @@ defCode := defCode , 'setupLocalStuff\'. defCode := defCode , ' ^ self\'. defCode := defCode , Character excla asString , ' ' , - Character excla asString , '\\'. + Character excla asString , '\\'. - code := code , defCode withCRs - + code := code , defCode withCRs. + ^ code. +! + +generateOutlets + ^ self ! ! !UIPainterView methodsFor:'generating output'! -generateOutlets - ^ self -! - generateSpecFor:something "generate a spec for a view or collection of views " @@ -449,8 +472,8 @@ ^ spec ! -generateWindowSpec - |spec specArray str| +generateWindowSpecMethodSource + |spec specArray str code| subViews remove:inputView. [ @@ -458,8 +481,8 @@ ] valueNowOrOnUnwindDo:[ subViews addFirst:inputView. ]. + specArray := spec literalArrayEncoding. - specArray := spec literalArrayEncoding. str := WriteStream on:String new. self prettyPrintSpecArray:specArray on:str indent:5. @@ -491,11 +514,15 @@ ^ code withCRs "Modified: 5.9.1995 / 21:01:35 / claus" -! +! ! + +!UIPainterView ignoredMethodsFor:'generating output'! nameOfClass ^ 'NewView' -! +! ! + +!UIPainterView methodsFor:'generating output'! outletValueOf:aSymbol for:aView "/ |c name p outlets moreCode sym typ val| @@ -619,7 +646,9 @@ newSpec name:name ]. -! +! ! + +!UIPainterView ignoredMethodsFor:'generating output'! subviewVariableNames |names| @@ -627,7 +656,9 @@ names := ''. viewProperties do:[:p| names := names , ' ' , (p name)]. ^ names -! +! ! + +!UIPainterView methodsFor:'generating output'! subviewsOf:aView do:aBlock |subs v| @@ -725,7 +756,6 @@ className := 'NewApplication'. methodName := 'windowSpec'. categoryName := 'Applications'. - viewProperties := OrderedCollection new. HandCursor := Cursor leftHand.