# HG changeset patch # User Claus Gittinger # Date 1200563725 -3600 # Node ID d6fec8c8e9cec7d7ec64b6bd1ecb1b1c2953fb0b # Parent 63b5fdc3c8a3df2498599da20b635f9ea9cf84fe changed #initialize diff -r 63b5fdc3c8a3 -r d6fec8c8e9ce UIPainter.st --- a/UIPainter.st Fri Jan 11 20:55:14 2008 +0100 +++ b/UIPainter.st Thu Jan 17 10:55:25 2008 +0100 @@ -13,8 +13,8 @@ ResourceSpecEditor subclass:#UIPainter instanceVariableNames:'specSuperclassName treeView selectionPanel specTool layoutTool - helpTool painterView painter' - classVariableNames:'SelectionPanelClass UseViewScroller' + helpTool painterView painter lastPort lastPage' + classVariableNames:'SelectionPanelClass UseViewScroller LastPort LastPage' poolDictionaries:'' category:'Interface-UIPainter' ! @@ -967,6 +967,93 @@ ) ! +dialogSpecForDefiningPortAndPageName + "This resource specification was automatically generated + by the UIPainter of ST/X." + + "Do not manually edit this!! If it is corrupted, + the UIPainter may not be able to read the specification." + + " + UIPainter new openOnClass:UIPainter andSelector:#dialogSpecForDefiningPortAndPagename + UIPainter new openInterface:#dialogSpecForDefiningPortAndPagename + " + + + + ^ + #(FullSpec + name: dialogSpecForDefiningPortAndPagename + window: + (WindowSpec + label: 'GUI Painter' + name: 'GUI Painter' + min: (Point 350 140) + max: (Point 500 140) + bounds: (Rectangle 0 0 346 138) + ) + component: + (SpecCollection + collection: ( + (FramedBoxSpec + label: 'Define Service And Pagename' + name: 'FramedBox' + layout: (LayoutFrame 0 0.0 3 0.0 0 1.0 -34 1.0) + labelPosition: topLeft + translateLabel: true + component: + (SpecCollection + collection: ( + (LabelSpec + label: 'Service (or Port):' + name: 'portLabel' + layout: (AlignmentOrigin 67 0.11 29 0 1 0.5) + translateLabel: true + resizeForLabel: true + adjust: right + ) + (InputFieldSpec + name: 'serviceOrPortName' + layout: (LayoutFrame 70 0.11 18 0 4 1.0 40 0) + tabable: true + model: serviceOrPortNameChannel + group: inputGroup + acceptOnPointerLeave: false + ) + (LabelSpec + label: 'Pagename:' + name: 'pageNameLabel' + layout: (AlignmentOrigin 67 0.11 54 0 1 0.5) + translateLabel: true + resizeForLabel: true + adjust: right + ) + (InputFieldSpec + name: 'pageNameNameField' + layout: (LayoutFrame 70 0.11 43 0 4 1.0 65 0) + tabable: true + model: pageNameNameChannel + group: inputGroup + acceptOnPointerLeave: false + ) + ) + + ) + ) + (UISubSpecification + name: 'subSpec' + layout: (LayoutFrame 0 0.0 -29 1 0 1.0 -5 1) + majorKey: ToolApplicationModel + minorKey: windowSpecForCommitWithoutChannels + ) + ) + + ) + ) + + "Created: / 14-01-2008 / 16:54:20 / cg" +! + windowSpec "This resource specification was automatically generated by the UIPainter of ST/X." @@ -1157,6 +1244,11 @@ isVisible: isStandAlone ) (MenuItem + label: 'Use Sketch...' + itemValue: useSketch + translateLabel: true + ) + (MenuItem label: '-' isVisible: isStandAlone ) @@ -1173,6 +1265,9 @@ translateLabel: true ) (MenuItem + label: '-' + ) + (MenuItem activeHelpKey: fileSaveAs label: 'Define Class and Selector...' itemValue: doDefineClassAndSelector @@ -1180,12 +1275,23 @@ isVisible: isStandAlone ) (MenuItem + activeHelpKey: filePickAnInterface + label: 'Pick a Window Spec...' + itemValue: doPickAView + translateLabel: true + ) + (MenuItem label: '-' ) (MenuItem - activeHelpKey: filePickAnInterface - label: 'Pick a Window Spec...' - itemValue: doPickAView + label: 'Launch' + itemValue: doStartApplication + translateLabel: true + ) + (MenuItem + enabled: canInstallAsWebPageHolder + label: 'Install as WebPage' + itemValue: doInstallAsWebPage translateLabel: true ) (MenuItem @@ -1331,20 +1437,28 @@ label: '-' ) (MenuItem + activeHelpKey: settingsAspectsAsInstances + enabled: hasSpecClass + label: 'Aspects as InstanceVariables' + translateLabel: true + isVisible: isNotEditingSpecOnly + indication: generateAspectsAsInstanceVariables: + ) + (MenuItem activeHelpKey: settingsRedefineAspectMethods enabled: hasSpecClass label: 'Redefine Aspect Methods' translateLabel: true + isVisible: isNotEditingSpecOnly indication: redefineAspectMethods: - isVisible: isNotEditingSpecOnly ) (MenuItem - activeHelpKey: settingsAspectsAsInstances + activeHelpKey: settingsGenerateCommentedCode enabled: hasSpecClass - label: 'Aspects as InstanceVariables' + label: 'Generate Commented Code' translateLabel: true - indication: generateAspectsAsInstanceVariables: isVisible: isNotEditingSpecOnly + indication: generateCommentedCode: ) (MenuItem label: 'AutoAccept on Selection-Change ' @@ -1962,6 +2076,15 @@ labelImage: (ResourceRetriever ToolbarIconLibrary start22x22Icon) ) (MenuItem + enabled: canInstallAsWebPageHolder + label: 'Install as WebPage' + itemValue: doInstallAsWebPage + translateLabel: true + isButton: true + isVisible: installAsWebPageVisible + labelImage: (ResourceRetriever XPToolbarIconLibrary installAsWebPage24x24Icon) + ) + (MenuItem label: '-' ) (MenuItem @@ -2255,6 +2378,23 @@ ^ builder booleanValueAspectFor:#canExchangeSelectionLayouts ! +canInstallAsWebPage + ^ self specClass notNil + and:[ self specClass isSubclassOf:WebApplicationModel ] + + "Created: / 14-01-2008 / 17:34:56 / cg" +! + +canInstallAsWebPageHolder + |a| + + a := builder booleanValueAspectFor:#canInstallAsWebPageHolder. + a value:self canInstallAsWebPage. + ^ a + + "Created: / 14-01-2008 / 17:36:04 / cg" +! + canMoveOrAlignSelection "returns a boolean value holder which is true in case that any selection exists and all widgets in the selection can change its layout through to a move or @@ -2344,6 +2484,12 @@ ^Icon helpIcon ! +installAsWebPageVisible + ^ true + + "Created: / 14-01-2008 / 17:46:05 / cg" +! + noteBookView "returns the notebook view; initialize the tools embedded in the notebook" @@ -2424,11 +2570,7 @@ ]. cls isNil ifTrue:[^ self]. - self modifiedChannel value ifTrue:[ - (self confirm:'Accept changes made to spec ?') ifTrue:[ - self accept - ] - ]. + self acceptOrIgnoreSectionModification. editor := DataSetBuilder new. specTool := self specTool. @@ -2471,6 +2613,8 @@ specTool specification rowClassName:(editor rowClassName). self modifiedChannel value:true. ]. + + "Modified: / 12-01-2008 / 10:31:47 / cg" ! openEditMenu @@ -2483,11 +2627,7 @@ ]. cls isNil ifTrue:[^ self]. - self modifiedChannel value ifTrue:[ - (self confirm:'Accept changes made to spec ?') ifTrue:[ - self accept - ] - ]. + self acceptOrIgnoreSectionModification. spec := self specTool specification. (selectorOrMenu := spec menuSelector) notNil ifTrue:[ @@ -2520,6 +2660,8 @@ self accept. ^ self ]. + + "Modified: / 12-01-2008 / 10:31:41 / cg" ! openHierarchicalListEditor @@ -2594,11 +2736,7 @@ ]. cls isNil ifTrue:[^ self]. - self modifiedChannel value ifTrue:[ - (self confirm:'Accept changes made to spec ?') ifTrue:[ - self accept - ] - ]. + self acceptOrIgnoreSectionModification. spec := self specTool specification. (selector := spec listSelector) isArray @@ -2616,6 +2754,8 @@ self accept. ] ]. + + "Modified: / 12-01-2008 / 10:31:34 / cg" ! ! !UIPainter methodsFor:'change & update'! @@ -2931,6 +3071,16 @@ !UIPainter methodsFor:'private'! +acceptOrIgnoreSectionModification + self isModified ifTrue:[ + (self confirm:'Accept changes made to spec ?') ifTrue:[ + self accept + ] + ]. + + "Created: / 12-01-2008 / 10:31:20 / cg" +! + askForModification "asks for window spec modification" @@ -3158,12 +3308,13 @@ specClass isNil ifTrue:[ specClassName notNil ifTrue:[ specClass := Smalltalk classNamed:specClassName. + self canInstallAsWebPageHolder value:self canInstallAsWebPage. ] ]. ^ specClass "Created: / 31-08-2006 / 10:08:43 / cg" - "Modified: / 04-09-2006 / 10:39:21 / cg" + "Modified: / 14-01-2008 / 17:39:32 / cg" ! specClass:aClassOrClassName @@ -3175,10 +3326,11 @@ ifFalse:[ specClass := Smalltalk classNamed:aClassOrClassName. specClassName := aClassOrClassName ]. + self canInstallAsWebPageHolder value:self canInstallAsWebPage. self helpTool loadFromClass:specClass. self clearModifiedFlag. - "Modified: / 31-08-2006 / 10:10:22 / cg" + "Modified: / 14-01-2008 / 17:39:08 / cg" ! ! !UIPainter methodsFor:'private-tools'! @@ -3274,6 +3426,18 @@ isUIPainter ^ true +! + +listOfAspects + ^ self painter listOfAspects + + "Created: / 12-01-2008 / 19:24:51 / cg" +! + +listOfCallbacks + ^ self painter listOfCallbacks + + "Created: / 12-01-2008 / 19:25:09 / cg" ! ! !UIPainter methodsFor:'selection'! @@ -3429,38 +3593,55 @@ generateAspectsAsInstanceVariables "if on, aspects are held as instance variables; - if off (the default), they are kept in the bindings dictionary. - " + if off (the default), they are kept in the bindings dictionary." + ^ UIPainterView generateAspectsAsInstanceVariables - "Created: / 29.7.1998 / 11:17:59 / cg" + "Created: / 29-07-1998 / 11:17:59 / cg" + "Modified: / 12-01-2008 / 10:37:43 / cg" ! generateAspectsAsInstanceVariables:aBoolean "if on, aspects are held as instance variables; - if off (the default), they are kept in the bindings dictionary. - " + if off (the default), they are kept in the bindings dictionary." + ^ UIPainterView generateAspectsAsInstanceVariables:aBoolean "Created: / 29.7.1998 / 11:18:20 / cg" ! +generateCommentedCode + "comments in generated aspect methods; yes or no." + + ^ UIPainterView generateCommentedCode + + "Created: / 12-01-2008 / 10:34:14 / cg" +! + +generateCommentedCode:aBoolean + "comments in generated aspect methods; yes or no." + + UIPainterView generateCommentedCode:aBoolean + + "Created: / 12-01-2008 / 10:23:10 / cg" +! + redefineAspectMethods - "redefine methods yes or no. If a method is defined in super class - should the message be reinstalled ? - " + "redefine methods yes or no. + If a method is defined in super class should the message be reinstalled ?" + ^ UIPainterView redefineAspectMethods - + "Modified: / 12-01-2008 / 10:34:07 / cg" ! redefineAspectMethods:aBoolean - "redefine methods yes or no. If a method is defined in super class - should the message be reinstalled ? - " + "redefine methods yes or no. + If a method is defined in super class should the message be reinstalled ?" + UIPainterView redefineAspectMethods:aBoolean - + "Modified: / 12-01-2008 / 10:23:20 / cg" ! ! !UIPainter methodsFor:'startup & release'! @@ -3782,11 +3963,13 @@ ifTrue:[ specSuperclassName ] ifFalse:[ 'ApplicationModel' ]) asValue). aspects at:#superclassNameDefaults - put:#( 'ApplicationModel' 'SimpleDialog' ) asValue. + put:#( 'ApplicationModel' 'SimpleDialog' 'WebApplicationModel') asValue. aspects at:#methodNameChannel put:((specSelector notNil ifTrue:[ specSelector asValue ] ifFalse:[ #windowSpec ]) asValue). + + "Modified: / 16-01-2008 / 10:44:55 / cg" ! ! !UIPainter methodsFor:'user actions'! @@ -3903,19 +4086,37 @@ ! doAskAndReplaceWidgetBy - |widgetClass| - - widgetClass := Dialog requestClass:'Spec- or View-Class:' okLabel:'OK' initialAnswer:nil. + |widgetClass list common| + + list := UISpecification allSubclasses + select:[:cls | Error handle:[ false ] do:[ cls viewClass notNil]]. + list sort:[:a :b | a name < b name]. + + common := self selectedSpec class commonReplacementClasses. + common notEmpty ifTrue:[ + list addAllFirst:(common , (Array with:'-')). + ]. + widgetClass := Dialog + requestClass:'Spec- or View-Class:' + list:list + okLabel:'OK' + initialAnswer:nil. widgetClass isNil ifTrue:[ ^ self ]. self replaceWidgetByClass:widgetClass + + "Modified: / 12-01-2008 / 23:50:25 / cg" ! doBrowseActionMethod:aspectSelector - "browse or create the action method as entered in the field" + "browse or create the action method as entered in the field (button beside input filed pressed)" + + self acceptOrIgnoreSectionModification. self doBrowseActionMethod:aspectSelector nameAs:aspectSelector + + "Modified: / 12-01-2008 / 10:32:12 / cg" ! doBrowseActionMethod:aspectSelector nameAs:aspectNameShown @@ -3963,9 +4164,13 @@ ! doBrowseAspectMethod:aspectSelector - "browse or create the aspect method as entered in the field" + "browse or create the aspect method as entered in the field (button beside input filed pressed)" + + self acceptOrIgnoreSectionModification. self doBrowseAspectMethod:aspectSelector nameAs:aspectSelector + + "Modified: / 12-01-2008 / 10:32:15 / cg" ! doBrowseAspectMethod:aspectSelector nameAs:aspectNameShown @@ -4005,7 +4210,7 @@ ]. code := painter generateAspectMethodFor:aspect - spec:nil + spec:spec inClass:cls. code readStream fileIn. ]. @@ -4296,6 +4501,63 @@ ! +doInstallAsWebPage + "lets user select a service, page-name and installs the page" + + |again serviceOrPort pageName port serviceLinkName service server app| + + serviceOrPort := lastPort ? LastPort ? '8080'. + pageName := lastPage ? LastPage ? 'myPage'. + + [ + again := false. + + aspects at:#serviceOrPortNameChannel put:serviceOrPort printString asValue. + aspects at:#pageNameNameChannel put:pageName printString asValue. + + (self openDialogInterface:#dialogSpecForDefiningPortAndPageName) ifFalse:[^ nil]. + + port := Integer readFrom:(aspects at:#serviceOrPortNameChannel) value onError:nil. + port isNil ifTrue:[ + serviceLinkName := (aspects at:#serviceOrPortNameChannel) value. + service := HTTPPortalService allSubInstances select:[:s | s linkName = serviceLinkName]. + service notEmptyOrNil ifTrue:[ + again := false. + service := service first. + ] ifFalse:[ + Dialog warn:'No such service' + ]. + ] ifFalse:[ + server := HTTPServer serverOnPort:port. + service := server + serviceForLink:'/portal' + ifAbsent:[ + service := HTTPPortalService new. + service linkName:'/portal'. + service class unRegisterServiceOn:server. + service registerServiceOn:server. + ]. + ]. + + pageName := (aspects at:#pageNameNameChannel) value. + ] doWhile:[again]. + + lastPage := LastPage := pageName. + lastPort := LastPort := port. + + app := self specClass new. + app link:pageName. + app service:service. + app defineInterface:(self specSelector). + app addToService. + +"/ self clearModifiedFlag. +"/ self helpTool buildAndMergeFromClass:specClassName. + self updateInfoLabel + + "Modified: / 15-01-2008 / 14:18:53 / cg" +! + doLoad "opens a ResourceSelectionBrowser for loading a window spec from a class" @@ -4611,6 +4873,20 @@ painter deleteSelectionBuffered:false. sel := painter pasteSpecifications:(Array with:newSpec) keepLayout:false. painter select:sel. +! + +useSketch + "selekt sketchfile to underly" + + |fn| + + fn := Dialog requestFileName:'Sketch ?' pattern:'*.TOP' fromDirectory:'f:'. + fn isNil ifTrue:[ + ^ self + ]. + painter useSketch:fn + + "Created: / 16-01-2008 / 17:49:20 / cg" ! ! !UIPainter::TreeView class methodsFor:'documentation'!