--- 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
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(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'!