diff -r 0a2b2ff030a0 -r 7542ab7fbbfe UIPainter.st --- a/UIPainter.st Tue Feb 25 14:15:56 1997 +0100 +++ b/UIPainter.st Tue Feb 25 15:07:09 1997 +0100 @@ -1,3 +1,25 @@ +" + COPYRIGHT (c) 1995 by Claus Gittinger + 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. +" + +'From Smalltalk/X, Version:3.1.4 on 25-feb-1997 at 2:17:26 pm' ! + +ApplicationModel subclass:#UIPainter + instanceVariableNames:'topView workView propertyView treeView elementMenu fileName + specClass specSelector specSuperclass aspects' + classVariableNames:'' + poolDictionaries:'' + category:'Interface-UIPainter' +! + HorizontalPanelView subclass:#ButtonPanel instanceVariableNames:'receiver argumentToSelector' classVariableNames:'' @@ -5,6 +27,961 @@ privateIn:UIPainter ! +!UIPainter class methodsFor:'documentation'! + +copyright +" + COPYRIGHT (c) 1995 by Claus Gittinger + 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 +" + not yet finished, not yet published, not yet released. + + [start with:] + UIPainter open +" +! ! + +!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 + " + + + + ^ + + #(#FullSpec + #'isOpaque:' true + #'window:' + #(#WindowSpec + #'name:' 'uIPainterView' + #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0) + #'isOpaque:' true + #'label:' 'unnamed' + #'bounds:' #(#Rectangle 0 0 300 300) + ) + #'component:' + #(#SpecCollection + #'collection:' + #( + #(#LabelSpec + #'name:' 'label1' + #'layout:' #(#LayoutFrame 10 0 50 0 110 0 70 0) + #'isOpaque:' true + #'label:' 'class:' + #'foregroundColor:' #(#Color 0.0 0.0 0.0) + #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) + #'initiallyInvisible:' false + #'level:' 0 + #'adjust:' #right + #'hasCharacterOrientedLabel:' true + ) + #(#LabelSpec + #'name:' 'label2' + #'layout:' #(#LayoutFrame 10 0 90 0 110 0 110 0) + #'isOpaque:' true + #'label:' 'superclass:' + #'foregroundColor:' #(#Color 0.0 0.0 0.0) + #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) + #'initiallyInvisible:' false + #'level:' 0 + #'adjust:' #right + #'hasCharacterOrientedLabel:' true + ) + #(#LabelSpec + #'name:' 'label3' + #'layout:' #(#LayoutFrame 10 0 130 0 110 0 150 0) + #'isOpaque:' true + #'label:' 'selector:' + #'foregroundColor:' #(#Color 0.0 0.0 0.0) + #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) + #'initiallyInvisible:' false + #'level:' 0 + #'adjust:' #right + #'hasCharacterOrientedLabel:' true + ) + #(#InputFieldSpec + #'name:' 'classNameField' + #'layout:' #(#LayoutFrame 120 0 50 0 289 0 69 0) + #'isOpaque:' true + #'initiallyDisabled:' false + #'initiallyInvisible:' false + #'model:' #classNameChannel + #'isReadOnly:' false + #'tabable:' true + #'immediateAccept:' false + #'acceptOnLeave:' true + #'acceptOnReturn:' true + #'acceptOnTab:' true + #'acceptOnLostFocus:' true + #'hasBorder:' false + ) + #(#InputFieldSpec + #'name:' 'superclassNameField' + #'layout:' #(#LayoutFrame 120 0 90 0 289 0 109 0) + #'isOpaque:' true + #'initiallyDisabled:' false + #'initiallyInvisible:' false + #'model:' #superclassNameChannel + #'isReadOnly:' false + #'tabable:' true + #'immediateAccept:' false + #'acceptOnLeave:' true + #'acceptOnReturn:' true + #'acceptOnTab:' true + #'acceptOnLostFocus:' true + #'hasBorder:' false + ) + #(#InputFieldSpec + #'name:' 'methodNameField' + #'layout:' #(#LayoutFrame 120 0 130 0 289 0 149 0) + #'isOpaque:' true + #'initiallyDisabled:' false + #'initiallyInvisible:' false + #'model:' #methodNameChannel + #'isReadOnly:' false + #'tabable:' true + #'immediateAccept:' false + #'acceptOnLeave:' true + #'acceptOnReturn:' true + #'acceptOnTab:' true + #'acceptOnLostFocus:' true + #'numChars:' 5 + #'hasBorder:' false + ) + #(#ActionButtonSpec + #'name:' 'button1' + #'layout:' #(#LayoutFrame 30 0 250 0 129 0 279 0) + #'isOpaque:' true + #'label:' 'cancel' + #'foregroundColor:' #(#Color 0.0 0.0 0.0) + #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) + #'initiallyInvisible:' false + #'tabable:' true + #'isDefault:' false + #'defaultable:' false + #'model:' #cancel + #'hasCharacterOrientedLabel:' true + #'isDecorated:' false + #'initiallyDisabled:' false + ) + #(#ActionButtonSpec + #'name:' 'button2' + #'layout:' #(#LayoutFrame 160 0 250 0 259 0 279 0) + #'isOpaque:' true + #'label:' 'ok' + #'foregroundColor:' #(#Color 0.0 0.0 0.0) + #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) + #'initiallyInvisible:' false + #'tabable:' true + #'isDefault:' true + #'defaultable:' false + #'model:' #accept + #'hasCharacterOrientedLabel:' true + #'isDecorated:' false + #'initiallyDisabled:' false + ) + #(#LabelSpec + #'name:' 'boxLabel' + #'layout:' #(#LayoutOrigin 78 0 11 0) + #'isOpaque:' true + #'label:' 'class & selector for code' + #'foregroundColor:' #(#Color 0.0 0.0 0.0) + #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) + #'initiallyInvisible:' false + #'level:' 0 + #'adjust:' #center + #'hasCharacterOrientedLabel:' true + ) + ) + ) + ) +! ! + +!UIPainter methodsFor:'BuilderView interface'! + +update:something + + elementMenu deselect. + treeView update:something. + propertyView update:something. +! ! + +!UIPainter methodsFor:'aspects'! + +aspectFor:aKey + ^ aspects at:aKey ifAbsent:[ super aspectFor:aKey ] + +! ! + +!UIPainter methodsFor:'filein & fileout'! + +openFile:aFileName + |aStream | + + aStream := FileStream readonlyFileNamed:aFileName. + + aStream notNil ifTrue:[ + workView fileInContentsFrom:aStream. + aStream close. + fileName := aFileName + ] + +! + +saveAs:aFileName + |aStream| + + aStream := FileStream newFileNamed:aFileName. + + aStream notNil ifTrue:[ + workView storeContentsOn:aStream. + aStream close. + fileName := aFileName + ]. + +! ! + +!UIPainter methodsFor:'help'! + +helpTextFor:aComponent + |sel| + + (aComponent isKindOf:Button) ifTrue:[ + (sel := aComponent changeMessage) notNil ifTrue:[ + "/ take the buttons change symbol as resource-key + ^ resources string:(sel asString) + ] + ]. + ^ nil + + "Modified: 31.8.1995 / 20:49:58 / claus" +! ! + +!UIPainter methodsFor:'initialization'! + +createCanvas + |topView| + + super initialize. + + 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. + + ^ workView. + + "Builder new createCanvas open" +! + +initChannels + |cls| + + 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:#methodNameChannel put:( + (specSelector notNil ifTrue:[specSelector] + ifFalse:[#windowSpec]) asValue + ). +! + +initPullDownMenu:aMenu + aMenu labels:(resources array:#( + 'file' + 'font' + 'type' + 'align' + 'dimension' + 'special' + 'misc' + 'code' + 'test' + )). + + aMenu selectors:#(#file + #font + #type + #align + #dimension + #special + #misc + #code + #test + ). + + aMenu at:#file + putLabels:(resources array: + #('new' + 'from class ...' + 'pick a view ' + '-' + 'load' + 'save' + 'save as ...' + '-' + 'install spec' + 'install aspects' + '-' +"/ 'source' + 'windowSpec' + 'inspect me' + 'raise' + '-' + 'print' + '-' + 'quit' + )) + selectors:#(doNew + doFromClass + doPickAView + nil + doOpen + doSave + doSaveAs + nil + doInstallSpec + doInstallAspects + nil +"/ doSource + doWindowSpec + inspect + doRaise + nil + doPrint + nil + doFinish + ) + receiver:self. + + aMenu at:#font putMenu:(workView subMenuFont menuView). + + aMenu at:#type + putLabels:(resources array:#( + 'basic widgets' + 'layout' + 'text' + 'interactors' + 'modal' + 'other' + '-' + 'all' + ) ) + selectors:#(showBasicWidgets + showLayoutWidgets + showTextWidgets + showInteractorWidgets + showModalWidgets + showOtherWidgets + nil + showAllWidgets + ) + receiver:self. + + aMenu at:#align putMenu:(workView subMenuAlign menuView). + aMenu at:#dimension putMenu:(workView subMenuDimension menuView). + + aMenu at:#special + putLabels:(resources array:#( + 'group radioButtons' + 'group enterFields' + '-' + 'delete undo history' + ) ) + selectors:#( + groupRadioButtons + groupEnterFields + nil + removeUndoHistory + ) + receiver:workView. + + aMenu at:#code + putLabels:(resources array:#( + 'class & method' + ) ) + selectors:#( + defineClassAndSelector + ) + receiver:self. + + aMenu at:#misc putMenu:(self menuMisc). + + aMenu at:#test + putLabels:(resources array:#( + '\c test mode' + ) ) + selectors:#(doToggleTest + ) + receiver:self. + + (aMenu menuAt:#test) checkToggleAt:#doToggleTest put:(workView testMode). +! + +openInterface + |inset panel menu| + + super initialize. + self initChannels. + workView := self createCanvas. + + topView := StandardSystemView new. + topView label:'Interface Builder'. + topView icon:(Image fromFile:'bitmaps/Builder.xbm' resolution:100). + topView extent:(600 @ 400). + + menu := PullDownMenu in:topView. + panel := ButtonPanel in:topView. + inset := menu preferredExtent y + panel preferredExtent y. + + panel origin:0.0@(menu preferredExtent y) corner:1.0@inset . + panel receiver:workView. + + elementMenu := HVScrollableView for:SelectionInListView miniScrollerH:true in:topView. + elementMenu origin:0.0@0.0 corner:0.3 @ 1.0. + elementMenu topInset:inset . + elementMenu := elementMenu scrolledView. + + elementMenu action:[:selection | + workView testMode ifTrue:[ + elementMenu deselect + ] ifFalse:[ + selection notNil ifTrue:[ + workView createWidgetWithClass: + (Smalltalk at:(elementMenu selectionValue asSymbol)) + ] + ] + ]. + + treeView := HVScrollableView for:UIPainterTreeView miniScrollerH:true in:topView. + treeView origin:0.3 @ 0.0 corner:0.6@1.0. + treeView topInset:inset . + treeView := treeView scrolledView. + treeView builderView:workView. + + propertyView := View origin:(0.6 @ 0.0) corner:1.0@1.0 in:topView. + propertyView topInset:inset . + propertyView := UIPropertyView in:propertyView receiver:workView. + + workView addDependent:self. + self initPullDownMenu:menu. + topView application:self. + builder window:topView. + topView beMaster. + workView topView beSlave. + topView open. + workView topView openInGroup:(topView windowGroup). +! + +openNewWindowCanvas + self open. + + +! + +openOnClass:aClass andSelector:aSelector + "open up an interface builder, fetching a spec from someClass + via some selector" + + |specArray| + + specClass := aClass name. + specSuperclass := aClass superclass name. + specSelector := aSelector. + + self openInterface. + workView className:aClass name. + workView methodName:aSelector. + workView setupFromSpec:(aClass perform:aSelector). +! + +openOnSpec:aSpecOrSpecArray + "open up an interface builder, given some specArray" + + |newBuilder| + + newBuilder := self new. +! ! + +!UIPainter methodsFor:'menus'! + +menuMisc + + |menuView menuGrid menuUndo| + + menuView := MenuView labels: + (resources array:#( + 'grid' + 'undo' + ) + ) + selectors:#( + #grid + #undo + ) + receiver:self. + + + menuGrid := PopUpMenu labels:( + resources array:#( + '\c show' + '\c align' + ) + ) + selectors:#( + #gridShown: + #gridAlign: + ) + receiver:workView. + + menuGrid checkToggleAt:#gridShown: put:(workView gridShown). + menuGrid checkToggleAt:#gridAlign: put:(workView gridAlign). + menuView subMenuAt:#grid put:menuGrid. + + menuUndo := PopUpMenu labels:( + resources array:#( + 'last' + 'menu' + '-' + 'delete' + ) + ) + selectors:#( + #undoLast + #openUndoMenu + nil + #removeUndoHistory + ) + receiver:workView. + + menuView subMenuAt:#undo put:menuUndo. + ^ menuView +! ! + +!UIPainter methodsFor:'setup choices'! + +showAllWidgets + "create list of basic widgets" + + self showWidgetsWhere:[:class | true] +! + +showBasicWidgets + "create list of basic widgets" + + self showWidgetsInCategory:'Views-Basic' + butNot:[:class | class isKindOf:ModalBox class] +! + +showInteractorWidgets + "create list of interactor widgets" + + self showWidgetsInCategory:'Views-Interactors' + butNot:[:class | class isKindOf:ModalBox class] +! + +showLayoutWidgets + "create list of basic widgets" + + self showWidgetsInCategory:'Views-Layout' + butNot:[:class | class isKindOf:ModalBox class] +! + +showModalWidgets + "create list of modal widgets" + + self showWidgetsWhere:[:class | class isKindOf:ModalBox class] +! + +showOtherWidgets + "create list of other widgets" + + |check cat| + + check := [:class | + (#('Views-Basic' + 'Views-Interactors' + 'Views-Layout' + 'Views-Text') includes:class category) not]. + self showWidgetsWhere:check + butNot:[:class | class isKindOf:ModalBox class] +! + +showTextWidgets + "create list of basic widgets" + + self showWidgetsInCategory:'Views-Text' + butNot:[:class | class isKindOf:ModalBox class] +! + +showWidgetsInCategory:aCategory + "create list of basic widgets" + + self showWidgetsWhere:[:class | class category = aCategory] +! + +showWidgetsInCategory:aCategory butNot:excludeBlock + "create list of basic widgets" + + self showWidgetsWhere:[:class | class category = aCategory] + butNot:excludeBlock +! + +showWidgetsWhere:aBlock + "create list of widgets where aBlock avaluates to true" + + self showWidgetsWhere:aBlock butNot:[:class | false] +! + +showWidgetsWhere:aBlock butNot:excludeBlock + "create list of widgets where aBlock evaluates to true and excludeBlock + evaluates to false" + + |list| + + list := OrderedCollection new:0. + SimpleView allSubclassesDo:[:aSubclass | + (aBlock value:aSubclass) ifTrue:[ + (excludeBlock value:aSubclass) ifFalse:[ + list add:(aSubclass name) + ] + ] + ]. + (aBlock value:View) ifTrue:[ + (excludeBlock value:View) ifFalse:[ + list add:'View' + ] + ]. + (list size == 0) ifFalse:[ + list sort + ]. + elementMenu list:list +! ! + +!UIPainter methodsFor:'user interaction'! + +closeRequest + workView notNil ifTrue:[workView release. workView := nil]. + super closeRequest +! + +closeRequestFor:aTopView + aTopView == topView ifTrue:[ + super closeRequestFor:aTopView + ] ifFalse:[ + topView device beep + ] +! ! + +!UIPainter methodsFor:'user interaction - dialogs'! + +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:[ + superclass := Smalltalk at:specSuperclass asSymbol + ] ifTrue:[ + superclass := specSuperclass + ]. + specSuperclass notNil ifTrue:[ + superclass 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" +! + +doInstallAspects + |code| + + (specClass isNil or:[specSelector isNil]) ifTrue:[ + self defineClassAndSelector + ]. + + self checkClassAndSelector ifFalse:[ + ^ self + ]. + + workView className:specClass superclassName:specSuperclass selector:specSelector. + + code := workView generateAspectMethods. + (ReadStream on:code) fileIn. + + "Modified: 4.9.1995 / 17:06:10 / claus" +! + +doInstallSpec + |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. +! + +doOpen + |box| + + box := FileSelectionBox new. + box title:(resources string:'Which file ?'). + box selectingDirectory:false. + box pattern:'*.*'. + box action:[:aFile| self openFile:aFile ]. + box open +! + +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 +! + +doRaise + workView topView raise +! + +doSave + fileName notNil ifTrue:[ + self saveAs:fileName + ] ifFalse:[ + self doSaveAs + ] +! + +doSaveAs + |box| + + box := FileSelectionBox new. + box title:(resources string:'Which file ?'). + box selectingDirectory:false. + box pattern:'*.*'. + box action:[:aFile| self saveAs:aFile ]. + box open +! ! + +!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'! + +doToggleTest + workView testMode:(workView testMode not) +! + +doWindowSpec + |code v| + + code := workView generateWindowSpecMethodSource. + code := code , workView generateAspectMethods. + v := CodeView open. + v contents:code. + v label:'windowSpec'. + ^ self + + "Modified: 5.9.1995 / 21:04:14 / claus" +! ! + +!UIPainter::ButtonPanel class methodsFor:'documentation'! + +version + ^ '$Header$' +! ! + !UIPainter::ButtonPanel methodsFor:'accessing'! receiver @@ -114,3 +1091,8 @@ ^ menu ! ! +!UIPainter class methodsFor:'documentation'! + +version + ^ '$Header$' +! !