cg@60: " cg@156: COPYRIGHT (c) 1995 by Claus Gittinger / eXept Software AG werner@1834: All Rights Reserved cg@60: cg@60: This software is furnished under a license and may be used cg@60: only in accordance with the terms of that license and with the tz@742: inclusion of the above copyright notice. This software may not cg@60: be provided or otherwise made available to, or used by, any cg@60: other person. No title to or ownership of the software is cg@60: hereby transferred. cg@60: " ca@1387: "{ Package: 'stx:libtool2' }" ca@1387: cg@3223: "{ NameSpace: Smalltalk }" cg@3223: cg@60: UIObjectView subclass:#UIPainterView cg@278: instanceVariableNames:'treeView listHolder superclassName className methodName cg@2244: categoryName handleColorBlack handleColorWhite handleMasterColor cg@2276: sketchPainter listOfAspectsHolder' cg@3097: classVariableNames:'HandCursor RedefineAspectMethods AspectsAsInstances' cg@60: poolDictionaries:'' cg@60: category:'Interface-UIPainter' cg@60: ! cg@60: cg@211: Object subclass:#ViewProperty cg@211: instanceVariableNames:'view spec identifier' cg@211: classVariableNames:'Identifier' cg@211: poolDictionaries:'' cg@211: privateIn:UIPainterView cg@211: ! cg@211: cg@60: !UIPainterView class methodsFor:'documentation'! cg@60: cg@60: copyright cg@60: " cg@156: COPYRIGHT (c) 1995 by Claus Gittinger / eXept Software AG werner@1834: All Rights Reserved cg@60: cg@60: This software is furnished under a license and may be used cg@60: only in accordance with the terms of that license and with the tz@742: inclusion of the above copyright notice. This software may not cg@60: be provided or otherwise made available to, or used by, any cg@60: other person. No title to or ownership of the software is cg@60: hereby transferred. cg@60: " cg@60: ! cg@60: cg@60: documentation cg@60: " ca@128: buildIn view used by the UIPainter; from this view, the layout of the ca@128: new application derives from. ca@128: ca@128: [see also:] werner@1834: UIBuilder werner@1834: UIObjectView cg@156: cg@156: [author:] werner@1834: Claus Gittinger werner@1834: Claus Atzkern cg@60: " cg@60: ! ! cg@60: sv@1225: !UIPainterView class methodsFor:'initialization'! sv@1225: sv@1225: initialize sv@1225: cg@1494: AspectsAsInstances := true. "/ false. sv@1225: RedefineAspectMethods := false. sv@1225: sv@1225: "Created: / 22.9.1999 / 12:32:31 / stefan" sv@1225: ! ! sv@1225: tz@698: !UIPainterView class methodsFor:'code generation mode'! tz@698: cg@925: generateAspectsAsInstanceVariables cg@925: "if on, aspects are held as instance variables; cg@2244: if off (the default), they are kept in the bindings dictionary." cg@2244: cg@925: ^ AspectsAsInstances cg@925: cg@925: "Created: / 29.7.1998 / 11:21:38 / cg" cg@925: "Modified: / 29.7.1998 / 11:22:01 / cg" cg@925: ! cg@925: cg@925: generateAspectsAsInstanceVariables:aBoolean cg@925: "if on, aspects are held as instance variables; cg@2244: if off (the default), they are kept in the bindings dictionary." cg@2244: cg@925: AspectsAsInstances := aBoolean cg@925: cg@925: "Created: / 29.7.1998 / 11:21:26 / cg" cg@925: "Modified: / 29.7.1998 / 11:22:11 / cg" cg@925: ! cg@925: cg@2244: generateCommentedCode cg@2244: "comments in generated aspect methods; yes or no." cg@2244: cg@2714: ^ UserPreferences current generateComments cg@2714: and:[ UserPreferences current generateCommentsForAspectMethods ] cg@2244: ! cg@2244: cg@2244: generateCommentedCode:aBoolean cg@2244: "comments in generated aspect methods; yes or no." cg@2244: cg@2716: UserPreferences current generateComments ifFalse:[ cg@2716: aBoolean ifTrue:[ cg@2716: UserPreferences current generateComments:true cg@2716: ]. cg@2716: ]. cg@2716: cg@2714: UserPreferences current cg@2716: generateCommentsForAspectMethods:aBoolean. cg@2244: ! cg@2244: tz@742: redefineAspectMethods cg@2244: "redefine methods yes or no. cg@2244: If a method is defined in super class should the message be reinstalled ?" cg@2244: sv@1225: ^ RedefineAspectMethods tz@698: sv@1225: "Modified: / 22.9.1999 / 12:33:03 / stefan" tz@698: ! tz@698: tz@742: redefineAspectMethods:aBoolean cg@2244: "redefine methods yes or no. cg@2244: If a method is defined in super class should the message be reinstalled ?" cg@2244: tz@742: RedefineAspectMethods := aBoolean tz@698: ! ! tz@698: cg@60: !UIPainterView class methodsFor:'defaults'! cg@60: werner@1834: defaultMenuMessage cg@60: "This message is the default yo be sent to the menuHolder to get a menu cg@60: " ca@121: ^ #showMiddleButtonMenu cg@60: cg@60: cg@60: ! ! cg@60: cg@60: !UIPainterView methodsFor:'accessing'! cg@60: cg@60: application cg@60: ^ nil cg@60: cg@60: "Modified: 6.9.1995 / 00:46:44 / claus" cg@60: ! cg@60: ca@78: applicationName ca@78: ^ self className ca@78: ! ca@78: ca@78: applicationName:aName ca@78: self className:aName ca@78: ! ca@78: cg@1977: class:aClass superclassName:aSuperclassName selector:aSelector cg@1977: self assert:(aClass isBehavior). cg@1977: className := aClass name. cg@1977: superclassName := aSuperclassName. cg@1977: methodName := aSelector. cg@1977: ! cg@1977: cg@60: className cg@60: ^ className cg@60: ! cg@60: ca@78: className:aName cg@1977: self assert:(aName isString). ca@78: className := aName cg@60: ! cg@60: cg@60: className:aClassName superclassName:aSuperclassName selector:aSelector cg@1977: self assert:(aClassName isString). ca@78: className := aClassName. cg@60: superclassName := aSuperclassName. ca@78: methodName := aSelector. cg@60: ! cg@60: cg@2276: listOfAspectsHolder:something cg@2276: listOfAspectsHolder := something. cg@2276: ! cg@2276: cg@60: methodName cg@60: ^ methodName cg@60: ! cg@60: ca@78: methodName:aName ca@78: methodName := aName cg@60: ! cg@60: cg@60: selectNames:aStringOrCollection cg@1031: |prop coll s n newSel| cg@1031: cg@1031: (aStringOrCollection size == 0) ifTrue:[ werner@1834: newSel := nil. cg@1031: ] ifFalse:[ werner@1834: (s := aStringOrCollection) isString ifFalse:[ werner@1834: s size == 1 ifTrue:[ werner@1834: s := s first werner@1834: ] ifFalse:[ werner@1834: coll := OrderedCollection new. werner@1834: werner@1834: s do:[:aName| werner@1834: (prop := self propertyOfName:aName) notNil ifTrue:[ werner@1834: coll add:(prop view) werner@1834: ] werner@1834: ]. werner@1834: (n := coll size) == 1 ifTrue:[ werner@1834: newSel := coll at:1 werner@1834: ] ifFalse:[ werner@1834: n == 0 ifTrue:[ werner@1834: newSel := nil werner@1834: ] ifFalse:[ werner@1834: newSel := coll werner@1834: ] werner@1834: ]. werner@1834: ^ self select:newSel. werner@1834: ] werner@1834: ]. werner@1834: werner@1834: prop := self propertyOfName:s. werner@1834: prop isNil ifTrue:[ werner@1834: newSel := nil werner@1834: ] ifFalse:[ werner@1834: newSel := prop view werner@1834: ]. cg@60: ]. cg@60: cg@1031: ^ self select:newSel cg@60: ! ! cg@60: ca@111: !UIPainterView methodsFor:'change & update'! ca@111: ca@223: layoutChanged cg@1445: treeView notNil ifTrue:[ werner@1834: treeView layoutChanged cg@1445: ] ca@111: ! ! ca@111: cg@60: !UIPainterView methodsFor:'copy & cut & paste'! cg@60: cg@2221: changeSelectionAfterPasteOf:sel cg@2221: sel notNil ifTrue:[ cg@2221: self select:sel. cg@2221: ]. cg@2221: ! cg@2221: cg@1744: commonContainerOf:someComponents cg@1744: |container| cg@1744: cg@1744: container := someComponents first container. cg@1744: [container notNil cg@1744: and:[ (someComponents conform:[:eachComponent | eachComponent isComponentOf:container]) not]] werner@1834: whileTrue:[ werner@1834: container := container container. cg@1744: ]. cg@1744: ^ container cg@1744: ! cg@1744: cg@60: copySelection cg@1959: "copy the selection into the cut & paste-buffer" cg@1959: cg@2362: |specs coll| ca@71: cg@2257: coll := self minClosedViewSetFor:(self selection). cg@60: ca@71: coll notNil ifTrue:[ ca@776: "/ self select:nil. cg@2362: specs := coll collect:[:eachView | self fullSpecWithAbsolutePositionFor:eachView]. ca@1870: self setClipboardObject:specs. ca@776: "/ treeView selection: sel cg@60: ]. cg@60: ! cg@60: tz@723: deleteSelection cg@1959: "delete the selection buffered" cg@1959: tz@887: self deleteSelectionBuffered: true tz@887: ! tz@887: ca@2396: deleteSelectionBuffered:buffered cg@2257: "cut the selection. If buffered is true, place it into the cut&paste-buffer" cg@2257: ca@2396: |specs viewsToRemove newSelection firstView| ca@71: tm@1621: treeView askForSelectionChangeAllowed ifFalse:[^ self]. tm@1621: ca@2396: viewsToRemove := self minClosedViewSetFor:(self selection). ca@2396: viewsToRemove isEmptyOrNil ifTrue:[ ^ self]. ca@2396: ca@2396: buffered ifTrue:[ ca@2396: specs := viewsToRemove collect:[:aView| self fullSpecWithAbsolutePositionFor:aView ]. ca@2396: self setClipboardObject:specs ca@2396: ]. ca@2396: firstView := viewsToRemove first. ca@2396: newSelection := self findContainerOfView:firstView. ca@2396: ca@2396: newSelection isNil ifTrue:[ ca@2396: newSelection := self. ca@2396: ] ifFalse:[ ca@2396: viewsToRemove size == 1 ifTrue:[ ca@2396: |subviews index| ca@2396: cg@2508: "/ newSelection components notEmptyOrNil ifTrue:[ self halt ]. ca@2396: subviews := newSelection subViews. ca@2396: ca@2396: subviews size > 1 ifTrue:[ ca@2396: index := subviews findFirst:[:eachView| eachView isSameOrComponentOf:firstView ]. ca@2396: index > 0 ifTrue:[ ca@2396: newSelection := subviews ca@2396: at:(index + 1) ca@2396: ifAbsent:[subviews at:index -1]. ca@2396: ]. ca@2396: ]. ca@2396: ]. ca@2396: ]. ca@2396: ca@2396: self withSelectionHiddenDo:[ ca@2396: self select:newSelection. ca@2396: cg@2257: treeView canvasEventsDisabledDo:[ ca@2396: self withinTransaction:#cut objects:viewsToRemove do:[ ca@2396: viewsToRemove reverseDo:[:aView| ca@1870: self createUndoRemove:aView. ca@1870: self remove:aView. ca@1870: ] ca@1870: ]. ca@2396: ]. ca@2396: self windowGroup processRealExposeEvents. ca@2396: ]. tz@698: ! tz@698: tz@723: deleteTotalSelection cg@1959: "delete the selection" cg@1959: tz@887: self deleteSelectionBuffered: false cg@60: ! cg@60: werner@1832: getSelectedViewsAndSpecs werner@1832: "return an array filed with selected views and corresponding specs. cg@1959: Nil if there is none." cg@1959: werner@1832: |specs coll sel| werner@1832: werner@1832: sel := treeView selection. werner@1832: cg@2257: coll := self minClosedViewSetFor:(self selection). werner@1832: werner@1832: coll isNil ifTrue:[^ nil]. werner@1832: werner@1832: specs := coll collect:[:aView| self fullSpecFor:aView ]. werner@1832: ^ Array with: coll with: specs werner@1832: ! werner@1832: cg@60: pasteBuffer sv@2311: "add the objects in the paste-buffer to the object view; sv@2311: don't change the layout if more than a single item has been selected" sv@2311: sv@2311: |sel clipboard| sv@2311: cg@2362: self enabled ifFalse:[ cg@2362: Dialog warn:'Operation currently disabled (In geometry test mode)'. cg@2362: ^ self cg@2362: ]. cg@2362: sv@2311: clipboard := self getClipboardObject. cg@2951: clipboard isString ifTrue:[ cg@2951: Dialog warn:'can only paste widgets here'. cg@2951: ] ifFalse:[ cg@2951: sel := self pasteSpecifications:clipboard keepLayout:true "(clipboard size > 1)". cg@2951: self changeSelectionAfterPasteOf:sel. cg@2951: ]. ca@89: ! ca@89: cg@1338: pasteKeepingPosition werner@1834: "add the objects in the paste-buffer to the object view; cg@1338: translate the layout as appropriate, to position the component cg@1959: at the same absolute position (relative to topView) as before" cg@1959: cg@1338: |sel| cg@1338: cg@1338: sel := self ca@1872: pasteSpecifications:(self getClipboardObject) ca@1872: keepLayout:true ca@1872: keepPosition:true cg@3055: at:#keep. cg@1338: cg@2221: self changeSelectionAfterPasteOf:sel. cg@1338: ! cg@1338: ca@2395: pasteSpecifications:aSpecificationOrList into:aContainerOrNil beforeIndex:anIndexOrNil keepLayout:keepLayout keepPosition:keepPosition at:aPointOrNilOrKeep cg@2537: "add the specs to the object view; cg@2537: if given a collection of specs, returns a list of pasted widgets; cg@2537: if given a single spec, returns that view (sigh - a stupid bw-compatibility kludge)" cg@2257: cg@2494: |sensor specsToPaste pasteOffset builder newSel mb@2560: bounds containerToPasteInto pastePoint beforeIndex count| tm@1621: tm@1621: treeView askForSelectionChangeAllowed ifFalse:[^ nil]. tm@1621: cg@2494: sensor := self window sensor. cg@2494: ca@2387: containerToPasteInto := aContainerOrNil. ca@2387: cg@2366: (aPointOrNilOrKeep == #keep cg@2494: or:[ sensor shiftDown cg@2494: or:[ sensor ctrlDown ]]) ifTrue:[ cg@2362: "/ paste into the selection ca@2387: containerToPasteInto isNil ifTrue:[ ca@2387: containerToPasteInto := self singleSelection. ca@2387: ]. cg@2362: ] ifFalse:[ cg@2362: "/ ignore the selection and paste where we drop!! cg@2366: pastePoint := aPointOrNilOrKeep. cg@2362: pastePoint isNil ifTrue:[ cg@3262: pastePoint := device cg@2494: translatePoint:(sensor mousePoint) cg@2362: fromView:nil cg@2362: toView:self. cg@2362: ]. ca@2387: containerToPasteInto isNil ifTrue:[ ca@2387: containerToPasteInto := self findObjectAt:pastePoint. ca@2387: ]. cg@2362: ]. cg@2362: cg@1744: containerToPasteInto isNil ifTrue:[ sv@1878: self selection size > 0 ifTrue:[ sv@1878: containerToPasteInto := self commonContainerOf:self selection sv@1878: ] ifFalse:[ sv@1878: containerToPasteInto := self sv@1878: ]. cg@2221: "/ self selection:containerToPasteInto. cg@1744: ]. cg@1744: cg@2362: "/ search up parent list for something we can paste into cg@2362: [containerToPasteInto notNil and:[(self canPasteInto:containerToPasteInto) not]] whileTrue:[ cg@2362: containerToPasteInto == self ifTrue:[ cg@2362: containerToPasteInto := nil cg@2362: ] ifFalse:[ cg@2362: containerToPasteInto := containerToPasteInto container. sv@1878: ]. tm@1621: ]. cg@1752: containerToPasteInto isNil ifTrue:[ sv@1878: containerToPasteInto := self cg@1752: ]. cg@60: cg@2221: (self canPaste:aSpecificationOrList into:containerToPasteInto) cg@2221: ifFalse:[ cg@2362: self enabled ifTrue:[ cg@2362: Dialog warn:'Cannot paste into selected component (not a container ?)'. cg@2362: ] ifFalse:[ cg@2951: Dialog warn:'Operation currently disabled (In geometry test mode)'. cg@2362: ]. sv@1878: ^ nil ca@89: ]. ca@223: cg@2537: self hideSelection. cg@2537: ca@776: aSpecificationOrList isCollection ifTrue:[ cg@2257: specsToPaste := aSpecificationOrList ca@776: ] ifFalse:[ cg@2257: specsToPaste := Array with:aSpecificationOrList ca@776: ]. cg@2221: "/ self setClipboardObject:nil. ca@776: ca@776: newSel := OrderedCollection new. ca@776: builder := UIBuilder new isEditing:true. ca@776: ca@776: className notNil ifTrue:[ sv@1878: builder applicationClass:(self resolveName:className) ca@776: ]. cg@2362: bounds := Rectangle origin:0@0 extent:(containerToPasteInto bounds extent). cg@2362: cg@2362: pasteOffset := 0. cg@60: ca@2395: (anIndexOrNil notNil and:[anIndexOrNil > 0]) ifTrue:[ ca@2395: beforeIndex := anIndexOrNil. ca@2395: ]. cg@2257: specsToPaste do:[:eachSpec| cg@2362: |view newOrigin uiPainterAttributes thisAbsOrigin| cg@2362: cg@2362: uiPainterAttributes := eachSpec otherAttributeAt:#uiPainterAttributes. sr@2388: eachSpec otherAttributeAt:#uiPainterAttributes put:nil. sv@1878: ca@2395: view := self addSpec:eachSpec builder:builder in:containerToPasteInto beforeIndex:beforeIndex. ca@2395: beforeIndex notNil ifTrue:[ ca@2395: beforeIndex := beforeIndex + 1 ca@2395: ]. cg@3575: cg@3575: containerToPasteInto isLayoutWrapper ifTrue:[ cg@3575: eachSpec layout:(#extent->view extent) cg@3575: ]. cg@3575: cg@3244: (keepLayout or:[eachSpec keepUILayout]) ifTrue:[ cg@3249: eachSpec layout isAssociation ifTrue:[ cg@3249: eachSpec layout key == #extent ifTrue:[ cg@3249: view pixelExtent:eachSpec layout value cg@3249: ] ifFalse:[ cg@3249: "/ self halt. cg@3249: view geometryLayout:eachSpec layout value cg@3249: ]. cg@3249: ] ifFalse:[ cg@3249: view geometryLayout:eachSpec layout. cg@3249: ] cg@3129: ] ifFalse:[ cg@3129: (keepPosition and:[ uiPainterAttributes notNil ]) ifTrue:[ cg@3129: aPointOrNilOrKeep == #keep ifTrue:[ cg@3129: newOrigin := uiPainterAttributes at:#origin. cg@3129: ] ifFalse:[ cg@3129: thisAbsOrigin := uiPainterAttributes at:#absOrigin. cg@3129: cg@3262: newOrigin := device cg@3129: translatePoint:thisAbsOrigin cg@3129: fromView:self cg@3129: toView:containerToPasteInto. cg@3129: ]. ca@2386: ] ifFalse:[ cg@3129: pastePoint isNil ifTrue:[ pastePoint := 0@0 ]. cg@3262: newOrigin := device cg@3502: translatePoint:pastePoint asPoint ca@2386: fromView:self ca@2386: toView:containerToPasteInto. ca@2386: ]. cg@3129: cg@3129: (bounds containsPoint:newOrigin) ifFalse:[ cg@3129: newOrigin := pasteOffset asPoint. cg@3129: pasteOffset := pasteOffset + 4. cg@3129: ]. cg@3129: newOrigin notNil ifTrue:[ cg@3129: self moveObject:view to:newOrigin. cg@3129: ]. sv@1878: ]. ca@2395: view realized ifFalse:[ ca@2395: view realize. ca@2395: ]. sv@1878: newSel add:view. ca@776: ]. cg@60: cg@2537: self cg@2537: withinTransaction:#paste cg@2537: objects:newSel cg@2537: do:[ cg@2537: undoHistory cg@2537: addUndoSelector:#undoCreate: cg@2537: withArgs:(newSel collect:[:v| (self propertyOfView:v) identifier]). cg@2537: self undoHistoryChanged. cg@2537: ]. cg@60: ca@776: self realizeAllSubViews. ca@2395: "/ newSel do:[:v| v raise]. cg@1744: self elementChangedSize:containerToPasteInto. ca@134: cg@2818: "/ nil wg if embedded in a browser cg@2818: self windowGroup notNil ifTrue:[ cg@2818: "/ because the new-created view will destroy the handles, when it redraws itself, cg@2818: "/ give it a chance to do so, before we return. (bail out after half a second, in case of trouble) cg@2818: count := 0. cg@2818: [ (newSel conform:[:v | v shown]) or:[count > 50] ] whileFalse:[ cg@2818: self windowGroup repairDamage. cg@2818: Delay waitForSeconds:0.01. cg@2818: count := count+1. cg@2818: ]. cg@2818: Delay waitForSeconds:0.01. mb@2560: self windowGroup repairDamage. cg@2537: ]. cg@2537: ca@776: newSel size == 1 ifTrue:[newSel := newSel at:1]. ca@223: ^ newSel cg@1500: cg@3502: "Modified: / 16-11-2017 / 23:49:56 / cg" cg@3575: "Modified: / 18-07-2018 / 09:15:44 / Claus Gittinger" ca@89: ! ca@89: cg@3055: pasteSpecifications:aSpecificationOrList into:aContainerOrNil keepLayout:keepLayout keepPosition:keepPosition at:aPointOrNilOrKeep ca@2395: "add the specs to the object view; returns list of pasted widgets" cg@3055: cg@3055: ^ self cg@3055: pasteSpecifications:aSpecificationOrList cg@3055: into:aContainerOrNil cg@3055: beforeIndex:nil cg@3055: keepLayout:keepLayout cg@3055: keepPosition:keepPosition cg@3055: at:aPointOrNilOrKeep ca@2395: ! ca@2395: ca@2387: pasteSpecifications:aSpecificationOrList keepLayout:keepLayout ca@2387: "add the specs to the object view; returns list of pasted widgets" ca@2387: ca@2387: ^ self ca@2387: pasteSpecifications:aSpecificationOrList ca@2387: keepLayout:keepLayout ca@2387: keepPosition:true cg@2627: at:#keep "/ nil ca@2387: ca@2387: "Modified: 11.8.1997 / 01:00:35 / cg" ca@2387: ! ca@2387: ca@2387: pasteSpecifications:aSpecificationOrList keepLayout:keepLayout at:aPointOrNil ca@2387: "add the specs to the object view; returns list of pasted widgets" ca@2387: ca@2387: ^ self ca@2387: pasteSpecifications:aSpecificationOrList ca@2387: keepLayout:keepLayout ca@2387: keepPosition:true ca@2387: at:aPointOrNil ca@2387: ! ca@2387: ca@2387: pasteSpecifications:aSpecificationOrList keepLayout:keepLayout keepPosition:keepPosition at:aPointOrNilOrKeep ca@2387: "add the specs to the object view; returns list of pasted widgets" ca@2387: ca@2387: ^ self pasteSpecifications:aSpecificationOrList ca@2387: into:nil ca@2395: beforeIndex:nil ca@2387: keepLayout:keepLayout ca@2387: keepPosition:keepPosition ca@2387: at:aPointOrNilOrKeep ca@2387: ! ca@2387: sv@2315: pasteWithLayout cg@2369: "add the objects in the paste-buffer to the object view - keep the old layout" sv@2315: sv@2315: |sel| sv@2315: cg@2366: sel := self cg@2366: pasteSpecifications:(self getClipboardObject) cg@2366: keepLayout:true cg@2366: keepPosition:true cg@2366: at:#keep. sv@2315: self changeSelectionAfterPasteOf:sel. sv@2315: ! sv@2315: sv@2311: pasteWithoutLayout cg@2369: "add the objects in the paste-buffer to the object view - do not keep the old layout" cg@1959: ca@223: |sel| ca@223: cg@2367: sel := self cg@2367: pasteSpecifications:(self getClipboardObject) cg@2367: keepLayout:false cg@2367: keepPosition:true cg@2367: at:#keep. cg@2221: self changeSelectionAfterPasteOf:sel. cg@2257: ! cg@2257: cg@2257: replaceSelectionBy:aNewSpec cg@2257: "replace the selected widget by another one." cg@2257: cg@3360: |oldSelection treeModel newView oldView container specs index| ca@2387: ca@2387: (self singleSelection notNil and:[treeView askForSelectionChangeAllowed]) ifFalse:[ ca@2387: ^ self ca@2387: ]. cg@3360: ca@2387: treeModel := treeView model. cg@2257: oldSelection := treeModel selectedNodes at:1 ifAbsent: nil. ca@2387: oldSelection isNil ifTrue:[^ self]. ca@2387: ca@2395: oldView := oldSelection contents view. ca@2395: ca@2395: (oldSelection hasChildren and:[aNewSpec class supportsSubComponents]) ifTrue:[ cg@3360: specs := cg@3360: oldSelection children collect:[:each| cg@3360: self fullSpecWithAbsolutePositionFor:(each contents view) cg@3360: ]. ca@2395: ]. ca@2387: ca@2387: aNewSpec ca@2387: otherAttributeAt:#uiPainterAttributes ca@2387: put:(Dictionary new ca@2387: at:#origin put:oldView origin; ca@2387: at:#extent put:oldView extent; ca@2387: at:#absOrigin put:(oldView originRelativeTo:self); ca@2387: yourself). ca@2387: cg@3360: index := oldSelection parent children identityIndexOf:oldSelection. ca@2387: container := self singleSelection container. cg@3360: ca@2387: self withinTransaction:#replaceBy objects:(Array with:oldView) do:[ ca@2395: self withSelectionHiddenDo:[ ca@2395: newView := self ca@2395: pasteSpecifications:(Array with:aNewSpec) ca@2395: into:container cg@3360: beforeIndex:index ca@2395: keepLayout:true ca@2395: keepPosition:true ca@2395: at:#keep. ca@2395: ca@2395: self deleteSelectionBuffered:false. ca@2395: ca@2395: specs size > 0 ifTrue:[ ca@2395: self pasteSpecifications:specs ca@2395: into:newView ca@2395: keepLayout:(aNewSpec class canResizeSubComponents) ca@2395: keepPosition:(aNewSpec class isLayoutContainer not) cg@3360: at:index. ca@2395: ]. ca@2395: self select:newView. ca@2395: ]. ca@2387: ]. ca@2395: ^ newView. cg@60: ! ! cg@60: cg@60: !UIPainterView methodsFor:'drag & drop'! cg@60: cg@2116: canDrop:aDropContext cg@2116: ^ self canDropObjects:aDropContext dropObjects cg@2116: cg@2116: "Created: / 13-10-2006 / 17:46:11 / cg" cg@2116: ! cg@2116: cg@2116: canDropObjects:aCollectionOfDropObjects cg@1914: "returns true if something can be dropped" cg@1914: cg@2362: ^ (true "aCollectionOfDropObjects size == 1" cg@2112: and:[ self enabled cg@2362: and:[ true "self numberOfSelections <= 1" cg@2362: and:[ aCollectionOfDropObjects conform:[:each| each theObject isKindOf:UISpecification] cg@2362: ]]]) cg@2112: cg@2116: "Created: / 13-10-2006 / 16:09:24 / cg" ca@223: ! ca@223: ca@285: canPaste cg@1914: "returns true if there is something which can be pasted in the clipboard" cg@1914: ca@1872: ^ self canPaste:(self getClipboardObject) ca@285: ! ca@285: ca@223: canPaste:something cg@1914: "returns true if something could be pasted" cg@1914: cg@2221: ^ self canPaste:something into:(self singleSelection) cg@2221: ! cg@2221: cg@2221: canPaste:something into:containerToPasteInto cg@2221: "returns true if something could be pasted" cg@2221: cg@2276: (self enabled) ifFalse:[ cg@1914: ^ false ca@223: ]. cg@2276: something isCollection ifTrue:[ cg@2276: something isEmpty ifTrue:[ ^ false]. cg@2276: ^ something conform:[:el | (self canPaste:el into:containerToPasteInto)] cg@2276: ]. cg@2276: cg@2276: (something isKindOf:UISpecification) ifFalse:[ cg@1914: ^ false ca@223: ]. ca@223: cg@2276: ^ self canPasteInto:containerToPasteInto ca@223: ! ca@223: ca@223: canPasteInto:aView cg@1914: "return true, if I can paste into a view" cg@1914: ca@285: |prop| cg@60: ca@1870: aView isNil ifTrue:[ ^ false ]. cg@2265: aView == self ifTrue:[ ^ true ]. ca@1870: ca@1870: (prop := self propertyOfView:aView) notNil ifTrue:[ ca@1870: ^ prop spec class supportsSubComponents ca@89: ]. ca@1870: ^ aView specClass supportsSubComponents. cg@60: ! cg@60: cg@2116: dropObjects:aCollectionOfDropObjects at:aPoint cg@2537: |spec newSel oldSel dragOffset dropPoint widg| cg@2537: ca@288: self selection notNil ifTrue:[ cg@1953: oldSel := self singleSelection. cg@1953: cg@1953: "/ search selections hierarchy for a widget into which we can paste cg@1953: widg := oldSel. cg@1953: [widg isNil or:[self canPasteInto:widg]] whileFalse:[ cg@1953: widg notNil ifTrue:[ cg@1953: widg := widg container cg@1953: ]. cg@1953: ]. cg@1953: cg@1953: oldSel := nil. cg@1953: self setSelection:widg withRedraw:true. ca@231: ]. cg@1953: spec := (aCollectionOfDropObjects at:1) theObject. cg@2537: cg@2537: dragOffset := DragAndDropManager dragOffsetQuerySignal query. cg@2537: aPoint isNil ifTrue:[ cg@2537: dropPoint := #keep. cg@2537: ] ifFalse:[ cg@2537: dropPoint := aPoint - dragOffset. werner@1833: ]. cg@2537: newSel := self pasteSpecifications:spec keepLayout:false keepPosition:false at:dropPoint. cg@2537: cg@2537: self select:(oldSel ? newSel). sv@1060: cg@2116: "Modified: / 18-03-1999 / 18:29:43 / stefan" cg@2116: "Created: / 13-10-2006 / 16:09:27 / cg" cg@60: ! ! cg@60: cg@2244: !UIPainterView methodsFor:'drawing'! cg@2244: cg@2244: clearRectangle:visRect cg@2244: super clearRectangle:visRect. cg@2244: sketchPainter notNil ifTrue:[ cg@2244: sketchPainter redrawInTargetView cg@2244: ]. cg@2244: cg@2244: "Created: / 16-01-2008 / 17:52:27 / cg" cg@2244: ! cg@2244: cg@2244: clearView cg@2244: super clearView. cg@2244: sketchPainter notNil ifTrue:[ cg@2244: sketchPainter redrawInTargetView cg@2244: ]. cg@2244: cg@2244: "Created: / 16-01-2008 / 17:46:08 / cg" cg@2244: ! cg@2244: cg@2248: useSketchFile:aFilename cg@2443: "a little neat goody: allow for a tablet-sketch file (WALTROP digital notepad) cg@2443: to be used as a background of the UIPainter window. This allows for sketches to cg@2443: be drawn, shown in the UIPainter, and then used as a placement hint (manual placement) cg@2443: for the user. Not a high-tech solution, but helped a lot, when we protoyped GUIs." cg@2443: cg@2248: |mime sketchPainterClass| cg@2248: cg@2248: mime := aFilename asFilename mimeTypeFromName. cg@2248: mime isNil ifTrue:[ cg@2248: mime := aFilename asFilename mimeTypeOfContents. cg@2248: ]. cg@2248: cg@2248: mime notNil ifTrue:[ sv@2278: (mime startsWith:'image') ifTrue:[ sv@2278: self viewBackground:(ImageReader fromFile:aFilename). sv@2278: ^ self. sv@2278: ]. cg@2444: mime = 'application/x-waltop-digital-notepad' ifTrue:[ cg@2444: sketchPainterClass := TOPFileDrawer. cg@2444: ]. cg@2248: ]. cg@2248: sketchPainterClass isNil ifTrue:[ cg@2444: self error:'Unsupported sketch file format' cg@2248: ]. cg@2248: cg@2248: sketchPainter := sketchPainterClass new. cg@2244: sketchPainter targetView:self. cg@2244: sketchPainter readFile:aFilename. cg@2244: sketchPainter ajustSketch. cg@2244: self invalidate. cg@2244: cg@2244: "Created: / 16-01-2008 / 17:46:26 / cg" cg@2244: ! ! cg@2244: ca@361: !UIPainterView methodsFor:'event handling'! ca@361: ca@361: keyPress:key x:x y:y view:aView cg@376: "a delegated keyEvent from aView" cg@376: ca@361: self keyPress:key x:x y:y ca@361: cg@376: "Modified: / 31.10.1997 / 20:27:22 / cg" ca@361: ! ca@361: ca@361: keyRelease:key x:x y:y view:aView cg@376: "a delegated keyEvent from aView" cg@376: ca@361: self keyRelease:key x:x y:y ca@361: cg@376: "Modified: / 31.10.1997 / 20:27:32 / cg" tz@754: ! tz@754: tz@754: sizeChanged:how tz@754: werner@1834: super sizeChanged:how. tz@754: tz@754: self layoutChanged ca@361: ! ! ca@361: ca@78: !UIPainterView methodsFor:'generating output'! ca@78: cg@352: aspectMethods cg@352: "extract a list of aspect methods - for browsing" cg@352: cg@1683: |cls methods| cg@352: cg@352: className isNil ifTrue:[ werner@1834: self warn:'No class defined !!'. werner@1834: ^ #() cg@352: ]. cg@352: cg@352: cls := self resolveName:className. cg@352: methods := IdentitySet new. cg@352: cg@1683: self aspectSelectorsAndTypesDo: werner@1834: [:selector :typeSymbol | werner@1834: |skip| werner@1834: werner@1834: (cls includesSelector:selector) ifTrue:[ werner@1834: werner@1834: skip := false. werner@1834: (typeSymbol == #modelAspect) ifTrue:[ werner@1834: (cls isSubclassOf:SimpleDialog) ifTrue:[ werner@1834: skip := SimpleDialog includesSelector:(selector asSymbol) werner@1834: ]. werner@1834: ]. werner@1834: skip ifFalse:[ werner@1834: methods add:(cls compiledMethodAt:selector) werner@1834: ]. werner@1834: ] werner@1834: ]. cg@1683: cg@1683: ^ methods cg@1683: cg@1683: "Created: / 25.10.1997 / 18:58:25 / cg" cg@1683: "Modified: / 26.10.1997 / 15:06:18 / cg" cg@1683: ! cg@1683: cg@1683: aspectSelectorsAndTypesDo:aTwoArgBlock cg@1683: "evaluate aBlock for every aspect methods selector; 2nd arg describes the aspects type" cg@1683: sv@1726: |cls selector protoSpec| cg@1683: cg@1683: className isNil ifTrue:[ sv@2195: self warn:'No class defined !!'. sv@2195: ^ self cg@1683: ]. cg@1683: cg@1683: cls := self resolveName:className. cg@1683: cg@352: treeView propertiesDo:[:aProp| sv@2195: |selector| sv@2195: sv@2195: (selector := aProp model) notNil ifTrue:[ sv@2195: selector isArray ifFalse:[ sv@2195: aTwoArgBlock value:(selector asSymbol) value:#modelAspect sv@2195: ]. sv@2195: ]. sv@2195: sv@2195: (selector := aProp menu) notNil ifTrue:[ sv@2195: selector isArray ifFalse:[ sv@2195: aTwoArgBlock value:(selector asSymbol) value:#menu sv@2195: ]. sv@2195: ]. sv@2195: sv@2195: (aProp spec aspectSelectors) do:[:aSel | cg@2250: (aSel isString or:[aSel isSymbol]) ifTrue:[ sv@2195: aTwoArgBlock value:(aSel asSymbol) value:#channelAspect sv@2195: ]. sv@2195: ]. sv@2195: aProp spec actionSelectors do:[:aSel| cg@2250: (aSel isString or:[aSel isSymbol]) ifTrue:[ sv@2195: aTwoArgBlock value:(aSel asSymbol) value:#actionSelector sv@2195: ]. sv@2195: ]. sv@2195: aProp spec valueSelectors do:[:aSel| cg@2250: (aSel isString or:[aSel isSymbol]) ifTrue:[ sv@2195: aTwoArgBlock value:(aSel asSymbol) value:#valueSelector sv@2195: ]. sv@2195: ] cg@352: ]. cg@352: cg@352: protoSpec := treeView canvasSpec. cg@352: cg@352: (selector := protoSpec menu) notNil ifTrue:[ sv@2195: selector isArray ifFalse:[ sv@2195: aTwoArgBlock value:(selector asSymbol) value:#menu sv@2195: ]. cg@352: ]. cg@352: ! cg@352: cg@60: generateActionMethodFor:aspect spec:protoSpec inClass:targetClass cg@2244: |selector args showIt codeStream alreadyInSuperclass numArgs method| ca@288: ca@288: selector := aspect asSymbol. ca@141: ca@288: alreadyInSuperclass := targetClass superclass canUnderstand:selector. ca@288: ca@568: numArgs := selector numArgs. ca@568: method := aspect. ca@568: ca@568: numArgs == 1 ifTrue:[ cg@2244: args := 'anArgument'. cg@2295: showIt := ''' , anArgument printString , ''...''.'. werner@1834: ] ifFalse:[ cg@2244: args := ''. cg@2244: showIt := ' ...''.'. cg@2244: cg@2244: numArgs ~~ 0 ifTrue:[ cg@2244: method := ''. cg@2244: cg@2244: selector keywords keysAndValuesDo:[:i :key| cg@2244: method := method, key, 'arg', i printString, ' ' cg@2244: ] cg@2244: ] ca@149: ]. cg@2244: codeStream := WriteStream on:(String new:100). cg@2244: codeStream cg@2244: nextPutLine:('!!',targetClass name,' methodsFor:''actions''!!'); cg@2244: nextPutLine:(method,args); cg@2244: nextPutLine:' '; cg@2244: cr. cg@2244: cg@2244: self class generateCommentedCode ifTrue:[ cg@2244: codeStream cg@2295: nextPutAll:' "automatically generated by UIPainter..." cg@2244: cg@2244: "*** the code below performs no action" cg@2244: "*** (except for some feedback on the Transcript)" cg@2244: "*** Please change as required and accept in the browser." cg@2244: "*** (and replace this comment by something more useful ;-)" cg@2244: cg@2244: '. cg@2244: cg@2244: alreadyInSuperclass ifTrue:[ cg@2244: codeStream cg@2244: nextPutLine:' "action for ' , aspect , ' is already provided in a superclass."'; cg@2244: nextPutLine:' "It may be redefined here..."'; cg@2244: cr. cg@2244: ] ifFalse:[ cg@2244: codeStream cg@2244: nextPutLine:' "action to be defined here..."'; cg@2244: cr. cg@2244: ]. cg@2244: ]. cg@2244: cg@2244: codeStream sv@3304: nextPutAll:' Logger info:'''. ca@288: ca@288: alreadyInSuperclass ifTrue:[ cg@2244: codeStream cg@2244: nextPutAll:'inherited '. ca@288: ]. cg@2244: codeStream cg@2244: nextPutAll:'action for '; cg@2244: nextPutAll:aspect; cg@2244: nextPutLine:showIt. ca@288: ca@288: alreadyInSuperclass ifTrue:[ cg@2244: codeStream cg@2244: nextPutAll:' super '; cg@2244: nextPutAll:aspect; cg@2244: nextPutAll:args; cg@2244: nextPutLine:'.'. ca@288: ]. ca@288: cg@2244: codeStream cg@2244: nextPutLine:'!! !!'; cr. cg@2244: cg@2244: ^ codeStream contents. cg@2244: cg@2244: "Modified: / 12-01-2008 / 10:21:52 / cg" cg@60: ! cg@60: cg@1683: generateAspectMethodCode cg@1683: "generate aspect, action & menu methods cg@1683: - but do not overwrite existing ones. cg@2714: Return a string ready to compile into the application class. cg@2714: TODO: refactor and move to CodeGenerator" cg@1683: cg@1683: ^ self generateAspectMethodCodeFiltering:nil cg@1683: ! cg@1683: cg@1683: generateAspectMethodCodeFiltering:aFilterOrEmpty cg@1683: "generate aspect, action & menu methods cg@1683: - but do not overwrite existing ones. cg@2714: Return a string ready to compile into the application class. cg@2714: TODO: refactor and move to CodeGenerator" cg@1683: cg@1683: |cls codePieces skip protoSpec thisCode cg@1683: definedMethodSelectors iVars t exportSels| cg@1683: cg@1683: cls := self targetClass. cg@1683: cls isNil ifTrue:[ cg@2024: ^ nil cg@1683: ]. cg@1683: cg@1683: codePieces := OrderedCollection new. cg@1683: definedMethodSelectors := IdentitySet new. cg@1683: cg@1683: treeView propertiesDo:[:aProp| cg@2024: |modelSelector| cg@2024: cg@2024: protoSpec := aProp spec. cg@2024: cg@2024: (modelSelector := aProp model) notNil ifTrue:[ cg@2024: self generateCodeFrom:(Array with:modelSelector) in:cls cg@2024: do:[:aSel| cg@2024: (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ cg@2024: skip := false. cg@2024: cg@2024: (cls isSubclassOf:SimpleDialog) ifTrue:[ cg@2024: skip := SimpleDialog includesSelector:aSel cg@2024: ]. cg@2024: (definedMethodSelectors includes:aSel) ifTrue:[ cg@2024: skip := true. cg@2024: ]. cg@2024: cg@2024: skip ifFalse:[ cg@2024: "/ kludge .. cg@2024: "/ (protoSpec isKindOf:ActionButtonSpec) cg@2024: (protoSpec defaultModelIsCallBackMethodSelector:aSel) cg@2024: ifTrue:[ cg@2024: thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls). cg@2024: ] ifFalse:[ cg@2024: thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). cg@2024: ]. cg@2024: codePieces add:thisCode. cg@2024: definedMethodSelectors add:aSel. cg@2024: Transcript showCR:'code generated for aspect: ' , aSel cg@2024: ] ifTrue:[ cg@2024: Transcript showCR:'*** no code generated for aspect: ' , aSel , ' (method already exists)' cg@2024: ]. cg@2024: ]. cg@2024: ]. cg@2024: ]. cg@2024: cg@2024: "/ for each aspect, generate getter (if not yet implemented) cg@2024: self generateCodeFrom:(aProp spec aspectSelectors) in:cls cg@2024: do:[:aSel| cg@2024: (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ cg@2024: (definedMethodSelectors includes:aSel) ifFalse:[ cg@2024: thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). cg@2024: codePieces add:thisCode. cg@2024: definedMethodSelectors add:aSel. cg@2024: Transcript showCR:'code generated for aspect: ' , aSel cg@2024: ] cg@2024: ] cg@2024: ]. cg@2024: cg@2024: "/ exported aspects - need setter methods cg@3092: exportSels := (treeView exportedAspects ? #()) collect:[:entry | (entry subAspect) asMutator]. cg@2024: self generateCodeFrom:exportSels in:cls cg@2024: do:[:aSel| cg@2024: |aspect| cg@2024: cg@2024: (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ cg@2024: (definedMethodSelectors includes:aSel) ifFalse:[ cg@3136: aspect := (aSel copyButLast) asSymbol. cg@2024: thisCode := (self generateAspectSetMethodFor:aspect spec:protoSpec inClass:cls). cg@2024: codePieces add:thisCode. cg@2024: definedMethodSelectors add:aSel. cg@2024: Transcript showCR:'export code generated for aspect: ' , aSel cg@2024: ] cg@2024: ] cg@2024: ]. cg@2024: cg@2024: self generateCodeFrom:(aProp spec actionSelectors) in:cls cg@2024: do:[:aSel| cg@2024: (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ cg@2024: (definedMethodSelectors includes:aSel) ifFalse:[ cg@2024: thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls). cg@2024: codePieces add:thisCode. cg@2024: definedMethodSelectors add:aSel. cg@2024: Transcript showCR:'action generated for aspect: ' , aSel cg@2024: ] cg@2024: ] cg@2024: ]. cg@2024: cg@2024: self generateCodeFrom:(aProp spec valueSelectors) in:cls cg@2024: do:[:aSel| cg@2024: (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ cg@2024: (definedMethodSelectors includes:aSel) ifFalse:[ cg@2024: "/ uppercase: - assume its a globals name. cg@2024: aSel isUppercaseFirst ifFalse:[ cg@2024: thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls). cg@2024: codePieces add:thisCode. cg@2024: definedMethodSelectors add:aSel. cg@2024: Transcript showCR:'code generated for aspect: ' , aSel cg@2024: ] cg@2024: ] cg@2024: ] cg@2024: ]. cg@1683: ]. cg@1683: cg@1683: AspectsAsInstances ifTrue:[ cg@2024: iVars := cls instVarNames asOrderedCollection. cg@2024: definedMethodSelectors do:[:ivar | cg@2024: (iVars includes:ivar) ifFalse:[ cg@2024: iVars add:ivar cg@2024: ] cg@2024: ]. cg@2024: iVars := iVars asArray. cg@2024: t := cls shallowCopy. cg@2024: t setInstanceVariableString:iVars asStringCollection asString. cg@2024: codePieces addFirst:(t definition , '!!\' withCRs). cg@1683: ]. cg@1683: werner@1834: ^ String cg@2024: streamContents: cg@2024: [:codeStream | cg@2024: codePieces do:[:eachPiece | codeStream nextPutAll:eachPiece]. cg@2024: ]. cg@1683: cg@1683: "Modified: / 29.7.1998 / 12:21:19 / cg" cg@1683: ! cg@1683: cg@60: generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass cg@2244: |modelClass modelValueString modelValue modelGen codeStream| ca@134: ca@149: modelClass := protoSpec defaultModelClassFor:aspect. cg@1257: modelValueString := protoSpec defaultModelValueStringFor:aspect. cg@1257: modelValueString notNil ifTrue:[ cg@2244: modelGen := modelValueString cg@1257: ] ifFalse:[ cg@2244: modelValue := protoSpec defaultModelValueFor:aspect. cg@2244: modelValue isNil ifTrue:[ cg@2244: modelGen := modelClass name , ' new' cg@2244: ] ifFalse:[ cg@2244: modelGen := modelValue storeString , ' asValue' cg@2244: ]. cg@352: cg@352: ]. ca@134: cg@2244: codeStream := WriteStream on:(String new:100). cg@2244: codeStream cg@2244: nextPutLine:('!!' , targetClass name , ' methodsFor:''aspects''!!'); cg@2244: nextPutLine:aspect; cg@2244: nextPutLine:' '; cg@2244: cr. cg@2244: cg@2244: self class generateCommentedCode ifTrue:[ cg@2244: codeStream cg@2244: nextPutAll:' "automatically generated by UIPainter ..." cg@2244: cg@2244: "*** the code below creates a default model when invoked." cg@2244: "*** (which may not be the one you wanted)" cg@2244: "*** Please change as required and accept it in the browser." cg@2244: "*** (and replace this comment by something more useful ;-)" cg@2244: cg@2244: '. cg@2244: ]. cg@1474: cg@925: AspectsAsInstances ifTrue:[ cg@2244: codeStream cg@2244: nextPutLine:(' ',aspect,' isNil ifTrue:['); cg@2244: nextPutLine:(' ',aspect,' := ',modelGen,'.'). cg@2244: cg@2244: modelClass ~~ TriggerValue ifTrue:[ cg@2244: self class generateCommentedCode ifTrue:[ cg@2244: codeStream cg@2244: nextPutLine:'"/ if your app needs to be notified of changes, uncomment one of the lines below:'. cg@2244: ]. cg@2244: codeStream cg@2244: nextPutLine:'"/ ',aspect,' addDependent:self.'; cg@2244: nextPutLine:'"/ ',aspect,' onChangeSend:#',aspect,'Changed to:self.'. cg@2244: ]. cg@2244: codeStream cg@2244: nextPutLine:' ].'; cg@2244: nextPutLine:' ^ ',aspect,'.'. cg@925: ] ifFalse:[ cg@2244: codeStream cg@2244: nextPutLine:(' |holder|'); cg@2244: cr; cg@2244: nextPutLine:(' (holder := builder bindingAt:#',aspect,') isNil ifTrue:['); cg@2244: nextPutLine:(' holder := ',modelGen,'.'); cg@2244: nextPutLine:(' builder aspectAt:#',aspect,' put:holder.'). cg@2244: cg@2244: modelClass ~~ TriggerValue ifTrue:[ cg@2244: self class generateCommentedCode ifTrue:[ cg@2244: codeStream cg@2244: nextPutLine:'"/ if your app needs to be notified of changes, uncomment one of the lines below:'. cg@2244: ]. cg@2244: codeStream cg@2244: nextPutLine:'"/ holder addDependent:self.'; cg@2244: nextPutLine:'"/ holder onChangeSend:#',aspect,'Changed to:self.'. cg@2244: ]. cg@2244: codeStream cg@2244: nextPutLine:' ].'; cg@2244: nextPutLine:' ^ holder.'. cg@925: ]. cg@1361: cg@2244: codeStream cg@2244: nextPutLine:'!! !!'; cr. cg@2244: "/ self halt. cg@2244: ^ codeStream contents. cg@2244: cg@2244: "Modified: / 22-09-1999 / 12:33:47 / stefan" cg@2244: "Modified: / 12-01-2008 / 10:21:43 / cg" cg@60: ! cg@60: ca@1358: generateAspectSelectorsMethod ca@1358: "generate aspectSelectors method. ca@1358: Return a string ready to compile into the application class." ca@1358: ca@1358: |cls code spec| ca@1358: cg@1683: cls := self targetClass. cg@1683: cls isNil ifTrue:[ werner@1834: ^ nil ca@1358: ]. ca@1358: ca@1358: spec := treeView exportedAspects. ca@1358: spec size == 0 ifTrue:[^ nil]. ca@1358: ca@1358: "/ make it an array ... cg@1362: spec := spec collect:[:entry | |subAspect type| werner@1834: subAspect := entry subAspect asSymbol. werner@1834: (type := entry type) isNil ifTrue:[ werner@1834: subAspect werner@1834: ] ifFalse:[ werner@1834: Array with:subAspect with:type asSymbol werner@1834: ]. werner@1834: ]. ca@1358: spec := spec asArray. ca@1358: ca@1358: code := '!!' , cls name , ' class methodsFor:''plugIn spec''!!\\' . ca@1358: ca@1358: code := code , 'aspectSelectors ca@1358: "This resource specification was automatically generated ca@1358: by the UIPainter of ST/X." ca@1358: ca@1358: "Do not manually edit this. If it is corrupted, ca@1358: the UIPainter may not be able to read the specification." ca@1358: ca@1358: "Return a description of exported aspects; ca@1358: these can be connected to aspects of an embedding application ca@1358: (if this app is embedded in a subCanvas)." ca@1358: cg@1362: ^ #(\'. cg@1362: spec do:[:el | code := code , (' ' , el storeString , '\') ]. cg@1362: code := code , ' ).\'. cg@1362: code := code , '\!!\'. ca@1358: code := code withCRs. ca@1358: ^ code ca@1358: cg@1362: "Modified: / 18.2.2000 / 02:08:34 / cg" ca@1358: ! ca@1358: cg@1361: generateAspectSetMethodFor:aspect spec:protoSpec inClass:targetClass cg@1361: |code| cg@1361: cg@1361: code := '!!' , targetClass name , ' methodsFor:''aspects - exported''!!\\' , cg@1361: aspect , ':something\' , cg@1361: ' "automatically generated by UIPainter ..."\\' , cg@1361: ' "This method is used when I am embedded as subApplication,"\' , cg@1361: ' "and the mainApp wants to connect its aspects to mine."\'. cg@1361: cg@1361: AspectsAsInstances ifTrue:[ werner@1834: code := (code , '\' , werner@1834: '"/ ' , aspect , ' notNil ifTrue:[\' , werner@1834: '"/ ' , aspect , ' removeDependent:self.\' , werner@1834: '"/ ].\' , werner@1834: ' ' , aspect ,' := something.\' , werner@1834: '"/ ' , aspect ,' notNil ifTrue:[\' , werner@1834: '"/ ' , aspect , ' addDependent:self.\' , werner@1834: '"/ ].\' , werner@1834: ' ^ self.\' , werner@1834: '!! !!\\') cg@1361: ] ifFalse:[ werner@1834: code := (code , '\' , werner@1834: '"/ |holder|\' , werner@1834: '\' , werner@1834: '"/ (holder := builder bindingAt:#' , aspect , ') notNil ifTrue:[\' , werner@1834: '"/ holder removeDependent:self.\' , werner@1834: '"/ ].\' , werner@1834: ' builder aspectAt:#' , aspect , ' put:something.\', werner@1834: '"/ something notNil ifTrue:[\' , werner@1834: '"/ something addDependent:self.\' , werner@1834: '"/ ].\' , werner@1834: ' ^ self.\' , werner@1834: '!! !!\\') cg@1361: ]. cg@1361: cg@1361: ^ code withCRs cg@1361: cg@1361: "Modified: / 29.7.1998 / 11:29:16 / cg" cg@1361: "Modified: / 22.9.1999 / 12:33:47 / stefan" cg@1361: ! cg@1361: tz@698: generateCodeFrom:aListOfSelectors in:aClass do:aBlock cg@1696: |realSelectors redefCondition redefMessage| cg@1696: cg@2250: realSelectors := aListOfSelectors select:[:sel | sel isString or:[sel isSymbol]]. tz@698: tz@744: self class redefineAspectMethods ifTrue:[ sv@2195: redefCondition := [:cls :sel | (cls includesSelector:sel) not]. sv@2195: redefMessage := ' skipped - already implemented in the class'. tz@698: ] ifFalse:[ sv@2195: redefCondition := [:cls :sel | (cls canUnderstand:sel) not]. sv@2195: redefMessage := ' skipped - already implemented in the class (or superclass)'. cg@1696: ]. cg@1696: cg@1696: realSelectors do:[:aSelector| sv@2195: (redefCondition value:aClass value:aSelector) ifTrue:[ sv@2195: aBlock value:aSelector asSymbol sv@2195: ] ifFalse:[ sv@2195: Transcript showCR:('#' , aSelector , redefMessage) sv@2195: ] tz@698: ] cg@376: ! cg@376: cg@376: generateHookMethodFor:selectorSpec comment:commentWhen note:noteOrNil defaultCode:defaultCode inClass:targetClass cg@376: ^ ('!!' , targetClass name , ' methodsFor:''hooks''!!\\' , cg@376: selectorSpec , '\' , cg@376: ' "automatically generated by UIPainter ..."\\' , cg@376: ' "*** the code here does nothing. It is invoked when"\' , cg@376: ' "*** ' , commentWhen , '"\' , cg@376: ' "*** Please change as required and accept in the browser."\' , cg@376: '\' , cg@376: ' "specific code to be added below ..."\' , cg@376: ' "' , (noteOrNil ? '') , '"\' , cg@376: '\' , cg@376: (defaultCode ? '^ self.') , cg@376: '!! !!\\') withCRs cg@376: cg@376: "Modified: / 25.10.1997 / 19:22:17 / cg" cg@376: "Created: / 31.10.1997 / 17:31:53 / cg" cg@376: ! cg@376: cg@376: generateHookMethods cg@376: "generate hook methods cg@376: - but do not overwrite existing ones. cg@376: Return a string ready to compile into the application class." cg@376: cg@1683: |cls| cg@1683: cg@1683: cls := self targetClass. cg@1683: cls isNil ifTrue:[ werner@1834: ^ nil cg@376: ]. cg@1683: cg@1683: ^ self generateHookMethodsInClass:cls. cg@376: ! cg@376: cg@376: generateHookMethodsInClass:targetClass cg@376: |code| cg@376: cg@376: code := ''. cg@376: cg@1554: (targetClass includesSelector:#postBuildWith:) ifFalse:[ werner@1834: code := code werner@1834: , (self werner@1834: generateHookMethodFor:'postBuildWith:aBuilder' werner@1834: comment:'the widgets have been built, but before the view is opened' werner@1834: note:'or after the super send' werner@1834: defaultCode:' super postBuildWith:aBuilder' werner@1834: inClass:targetClass) cg@376: ]. cg@1554: (targetClass includesSelector:#postOpenWith:) ifFalse:[ werner@1834: code := code werner@1834: , (self werner@1834: generateHookMethodFor:'postOpenWith:aBuilder' werner@1834: comment:'the topView has been opened, but before events are dispatched for it' werner@1834: note:'or after the super send' werner@1834: defaultCode:' super postOpenWith:aBuilder' werner@1834: inClass:targetClass) cg@376: ]. cg@1554: (targetClass includesSelector:#closeRequest) ifFalse:[ werner@1834: code := code werner@1834: , (self werner@1834: generateHookMethodFor:'closeRequest' werner@1834: comment:'the topView has been asked to close' werner@1834: note:'return without the ''super closeRequest'' to stay open' werner@1834: defaultCode:' ^super closeRequest' werner@1834: inClass:targetClass) cg@376: ]. cg@376: ^ code cg@376: cg@376: "Modified: / 31.10.1997 / 17:30:34 / cg" cg@376: "Created: / 31.10.1997 / 17:32:49 / cg" ca@316: ! ca@316: cg@965: generateMenuMethodFor:menuSel inClass:targetClass cg@1805: |selector args showIt code alreadyInSuperclass numArgs method category| cg@965: cg@965: selector := menuSel asSymbol. cg@1805: category := UserPreferences current categoryForMenuActionsMethods. cg@965: cg@965: alreadyInSuperclass := targetClass superclass canUnderstand:selector. cg@965: cg@1805: code := '!!' , targetClass name , ' methodsFor:''' , category , '''!!\\'. cg@965: cg@965: selector = 'openAboutThisApplication' ifTrue:[ werner@1834: code := code , werner@1834: 'openAboutThisApplication\' , werner@1834: ' "opens an about box for this application."\\' , werner@1834: ' "automatically generated by UIPainter ..."\\' , werner@1834: werner@1834: ' |rev box myClass clsRev image msg|\\' , werner@1834: werner@1834: ' rev := ''''.\' , werner@1834: ' myClass := self class.\' , werner@1834: werner@1834: ' (clsRev := myClass revision) notNil ifTrue:[\' , werner@1834: ' rev := '' (rev: '', clsRev printString, '')''].\\' , werner@1834: werner@1834: ' msg := Character cr asString , myClass name asBoldText, rev.\' , werner@1834: ' msg := (msg , ''\\*** add more info here ***\\'') withCRs.\\' , werner@1834: ' box := AboutBox title:msg.\' , werner@1834: werner@1834: ' "/ *** add a #defaultIcon method in the class\' , werner@1834: ' "/ *** and uncomment the following line:\' , werner@1834: ' "/ image := self class defaultIcon.\\' , werner@1834: ' image notNil ifTrue:[\' , werner@1834: ' box image:image\' , werner@1834: ' ].\' , werner@1834: ' box label:(resources string:''About %1'' with:myClass name).\' , werner@1834: ' box autoHideAfter:10 with:[].\' , werner@1834: ' box showAtPointer.\' , werner@1834: '!! !!\\'. werner@1834: ^ code withCRs cg@965: ]. cg@965: cg@965: selector = 'menuOpen' ifTrue:[ werner@1834: code := code , werner@1834: 'menuOpen\' , werner@1834: ' "automatically generated by UIPainter ..."\\' , werner@1834: ' "*** the code below opens a dialog for file selection"\' , werner@1834: ' "*** and invokes the #doOpen: method with the selected file."\' , werner@1834: ' "*** Please change as required and accept in the browser."\\' , werner@1834: ' |file|\\' , werner@1834: ' file :=\' , werner@1834: ' (FileSelectionBrowser\' , werner@1834: ' request: ''Open''\' , werner@1834: ' fileName: ''''\' , werner@1834: ' "/ inDirectory: lastOpenDirectory\' , werner@1834: ' withFileFilters: #(''*'')).\\' , werner@1834: ' file notNil ifTrue:[\' , werner@1834: ' "/ lastOpenDirectory := file asFilename directory.\' , werner@1834: ' self doOpen:file\' , werner@1834: ' ]\' , werner@1834: '!! !!\'. werner@1834: ^ code withCRs cg@965: ]. cg@965: cg@965: numArgs := selector numArgs. cg@965: method := selector. cg@965: cg@965: numArgs == 1 ifTrue:[ werner@1834: args := 'anArgument'. werner@1834: showIt := ''' , anArgument printString , '' ...''.\'. werner@1834: ] ifFalse:[ werner@1834: args := ''. werner@1834: showIt := ' ...''.\'. werner@1834: werner@1834: numArgs ~~ 0 ifTrue:[ werner@1834: method := ''. werner@1834: werner@1834: selector keywords keysAndValuesDo:[:i :key| werner@1834: method := method, key, 'arg', i printString, ' ' werner@1834: ] werner@1834: ] cg@965: ]. cg@965: cg@965: code := code , werner@1834: method , args , '\' , werner@1834: ' "automatically generated by UIPainter ..."\\' , werner@1834: ' "*** the code below performs no action"\' , werner@1834: ' "*** (except for some feedback on the Transcript)"\' , werner@1834: ' "*** Please change as required and accept in the browser."\' , werner@1834: '\' . cg@965: cg@965: alreadyInSuperclass ifTrue:[ werner@1834: code := code , werner@1834: ' "action for ' , selector , ' is already provided in a superclass."\' , werner@1834: ' "It may be redefined here ..."\\'. cg@965: ] ifFalse:[ werner@1834: code := code , werner@1834: ' "action to be added ..."\\'. cg@965: ]. cg@965: cg@965: code := code , werner@1834: ' Transcript showCR:self class name, '': '. cg@965: alreadyInSuperclass ifTrue:[ werner@1834: code := code , 'inherited '. cg@965: ]. cg@965: code := code , 'menu action for ' , selector , showIt. cg@965: cg@965: alreadyInSuperclass ifTrue:[ werner@1834: code := code , werner@1834: ' super ' , selector , args , '.\'. cg@965: ]. cg@965: cg@965: code := code , werner@1834: '!! !!\\'. cg@965: ^ code withCRs cg@965: cg@965: "Created: / 23.8.1998 / 16:46:51 / cg" cg@965: "Modified: / 23.8.1998 / 18:13:05 / cg" cg@965: ! cg@965: cg@965: generateMenuMethods cg@965: "generate menu methods cg@965: - but do not overwrite existing ones. cg@965: Return a string ready to compile into the application class." cg@965: cg@1069: |cls code menuSelector thisCode cg@1069: definedMethodSelectors cg@2276: spec specArray fullSpec winSpec menuSpec| cg@965: cg@1683: cls := self targetClass. cg@1683: cls isNil ifTrue:[ cg@2276: ^ nil cg@965: ]. cg@965: cg@2276: spec := treeView generateFullSpecForComponents:#() named:nil. cg@2276: specArray := spec literalArrayEncoding. cg@965: fullSpec := specArray decodeAsLiteralArray. cg@965: winSpec := fullSpec window. cg@965: menuSelector := winSpec menu. cg@965: werner@1834: (menuSelector notNil cg@1069: and:[ (cls respondsTo:menuSelector) ]) ifFalse:[ cg@2276: self warn:'No menu defined (yet)'. cg@2276: ^ nil. cg@965: ]. cg@965: menuSpec := cls perform:menuSelector. cg@965: menuSpec := menuSpec decodeAsLiteralArray. cg@965: cg@965: definedMethodSelectors := IdentitySet new. cg@965: code := ''. cg@965: cg@965: menuSpec allItemsDo:[:item | cg@2276: |sel| cg@2276: cg@2276: (sel := item value) notNil ifTrue:[ cg@2276: (definedMethodSelectors includes:sel) ifFalse:[ cg@2276: self generateCodeFrom:(Array with:sel) in:cls do:[:aSel| cg@2276: thisCode := (self generateMenuMethodFor:aSel inClass:cls). cg@2276: code := code, thisCode. cg@2276: ]. cg@2276: definedMethodSelectors add:sel. cg@2276: ]. cg@2276: ] cg@965: ]. cg@965: cg@965: (definedMethodSelectors includes:#menuOpen) ifTrue:[ cg@2276: self generateCodeFrom:(Array with:#doOpen:) in:cls do:[:aSel| cg@2276: thisCode := (self generateMenuMethodFor:aSel inClass:cls). cg@2276: code := code, thisCode. cg@2276: ]. cg@965: ]. cg@965: cg@965: ^ code cg@965: cg@965: "Created: / 23.8.1998 / 16:12:09 / cg" cg@965: "Modified: / 23.8.1998 / 18:12:23 / cg" cg@965: ! cg@965: ca@188: generateValueMethodFor:aspect spec:protoSpec inClass:targetClass ca@188: ^ ('!!' , targetClass name , ' methodsFor:''values''!!\\' , ca@188: aspect , '\' , cg@352: ' "automatically generated by UIPainter ..."\\' , cg@352: ' "*** the code below returns a default value when invoked."\' , cg@352: ' "*** (which may not be the one you wanted)"\' , cg@352: ' "*** Please change as required and accept in the browser."\' , ca@188: '\' , ca@188: ' "value to be added below ..."\' , ca@188: ' Transcript showCR:self class name , '': no value yet for ' , aspect , ' ...''.\' , ca@188: '\' , ca@188: '^ nil.' , ca@188: '!! !!\\') withCRs ca@188: cg@352: "Modified: / 25.10.1997 / 19:22:17 / cg" ca@188: ! ca@188: cg@2197: generateWindowSpec cg@3038: |spec addToSpec specsAlready| cg@60: ca@310: spec := OrderedCollection new. cg@3038: specsAlready := IdentitySet new. cg@60: cg@2499: addToSpec := cg@2499: [:aView| cg@2499: |vSpec| cg@2499: "/ care for wrapped views ... cg@2499: vSpec := self fullSpecFor:aView. cg@2499: vSpec isNil ifTrue:[ cg@2499: aView subViews size == 1 ifTrue:[ cg@2499: vSpec := self fullSpecFor:(aView subViews first). cg@2499: ] cg@2499: ]. cg@2499: vSpec isNil ifTrue:[ cg@2505: (Dialog cg@2505: confirm:('Oops - could not create spec for view: %1\\Continue ?' bindWith:aView printString) withCRs cg@2505: noLabel:'Abort') cg@2505: ifFalse:[ sv@3067: AbortOperationRequest raise cg@2505: ]. cg@2499: ]. cg@3038: (specsAlready includes:vSpec) ifTrue:[self halt]. cg@3038: specsAlready add:vSpec. cg@2499: spec add:vSpec cg@2197: ]. cg@2499: cg@2499: self subViews do:addToSpec. cg@2499: self components do:addToSpec. tm@1058: spec := treeView generateFullSpecForComponents:spec named:methodName. cg@2197: ^ spec cg@3038: cg@3038: "Modified: / 30-07-2013 / 09:13:13 / cg" cg@2197: ! cg@2197: cg@2197: generateWindowSpecMethodSource cg@3031: ^ self cg@3031: generateWindowSpecMethodSourceFor:(self generateWindowSpec) cg@3031: class:className cg@3031: selector:methodName cg@3031: cg@3031: "Modified: / 5.9.1995 / 21:01:35 / claus" cg@3031: "Modified: / 15.10.1998 / 11:29:53 / cg" cg@3031: ! cg@3031: cg@3031: generateWindowSpecMethodSourceFor:spec class:className selector:methodName cg@3031: |specArray str code category cls mthd specCode| cg@3031: cg@2276: specArray := spec literalArrayEncoding. cg@2197: sv@3327: str := WriteStream on:''. cg@3031: UISpecification prettyPrintSpecArray:specArray on:str indent:4. cg@464: specCode := str contents. cg@457: cg@457: (specCode includes:$!!) ifTrue:[ cg@2197: "/ oops - must be chunk format ... sv@3327: str := WriteStream on:''. cg@2197: str nextPutAllAsChunk:specCode. cg@2197: specCode := str contents. cg@457: ]. cg@60: cg@178: "/ if that method already exists, do not overwrite the category cg@178: cg@178: category := 'interface specs'. ca@330: cls := self resolveName:className. ca@330: ca@330: cls notNil ifTrue:[ cg@2197: (mthd := cls class compiledMethodAt:methodName asSymbol) notNil ifTrue:[ cg@2197: category := mthd category. cg@2197: ] cg@178: ]. cg@178: cg@238: code := '!!' cg@2197: , className , ' class methodsFor:' , category storeString cg@2197: , '!!' , '\\' cg@2197: cg@2197: , methodName , '\' cg@2197: , ((ResourceSpecEditor codeGenerationCommentForClass: UIPainter) replChar:$!! withString:'!!!!') cg@2197: , '\\ "\' cg@2197: , (' UIPainter new openOnClass:' , className , ' andSelector:#' , methodName , '\'). cg@1013: cg@1050: (cls notNil and:[cls isSubclassOf:ApplicationModel]) ifTrue:[ cg@2197: code := code cg@2197: , (' ' , className , ' new openInterface:#' , methodName , '\'). cg@1013: ]. cg@1013: cg@1013: code := code cg@2197: ,(methodName = 'windowSpec' cg@2197: ifTrue:[' ' , className , ' open\'] ifFalse: ['']) cg@2197: , ' "\'. werner@1834: werner@1834: code := code cg@2197: , '\' cg@3223: , ' \\'. cg@3223: code := code withCRs. cg@3223: code := code cg@2197: , ' ^ ' , specCode cg@3223: , '\' withCRs cg@2197: , '!! !!' cg@3223: , '\\' withCRs. cg@3223: cg@3223: ^ code cg@1683: ! cg@1683: cg@2244: listOfAspects cg@2244: |cls aspects| cg@2244: cg@2276: listOfAspectsHolder notNil ifTrue:[ cg@2276: ^ listOfAspectsHolder value cg@2276: ]. cg@2276: cg@2244: aspects := IdentitySet new. cg@2244: cg@2244: cls := self targetClass. cg@2244: cls notNil ifTrue:[ cg@2265: cls withAllSuperclassesDo:[:cls | cg@2265: cls methodsDo:[:m | cg@3293: ((m resources ? #()) includes:#uiAspect) ifTrue:[ cg@2265: aspects add:m selector cg@2265: ]. cg@2265: ] cg@2244: ] cg@2244: ]. cg@2244: cg@2244: treeView propertiesDo:[:aProp| cg@2244: |modelSelector| cg@2244: cg@2244: (modelSelector := aProp model) notNil ifTrue:[ cg@2244: aspects add:modelSelector asSymbol cg@2244: ]. cg@2244: cg@2244: "/ aspects addAll:aProp spec actionSelectors. cg@2250: cg@2250: aspects addAll:(aProp spec valueSelectors select:[:a | a isString or:[a isSymbol]]). cg@2250: aspects addAll:(aProp spec aspectSelectors select:[:a | a isString or:[a isSymbol]]). cg@2244: ]. cg@2244: cg@2244: ^ aspects asOrderedCollection sort. cg@2244: cg@2244: "Created: / 12-01-2008 / 19:24:45 / cg" cg@2244: ! cg@2244: cg@2244: listOfCallbacks cg@2244: |cls aspects| cg@2244: cg@2244: aspects := IdentitySet new. cg@2244: cg@2244: cls := self targetClass. cg@2244: cls notNil ifTrue:[ cg@2244: cls methodsDo:[:m | cg@3293: ((m resources ? #()) includes:#uiCallback) ifTrue:[ cg@2244: aspects add:m selector cg@2244: ]. cg@2244: ] cg@2244: ]. cg@2244: cg@2244: treeView propertiesDo:[:aProp| cg@2244: |modelSelector| cg@2244: cg@2244: aspects addAll:aProp spec actionSelectors. cg@2244: "/ aspects addAll:aProp spec valueSelectors. cg@2244: "/ aspects addAll:aProp spec aspectSelectors. cg@2244: ]. cg@2244: cg@2244: ^ aspects asOrderedCollection sort. cg@2244: cg@2244: "Created: / 12-01-2008 / 19:25:19 / cg" cg@2244: ! cg@2244: cg@1683: targetClass cg@1683: |cls| cg@1683: cg@1683: className isNil ifTrue:[ cg@2248: self warn:'No TargetClass defined !!'. cg@2248: ^ nil cg@1683: ]. cg@1683: (cls := self resolveName:className) isNil ifTrue:[ cg@2248: "/ self warn:('Class ', className asString, ' does not exist !!'). cg@2248: ^ nil cg@1683: ]. cg@1683: ^ cls. cg@60: ! ! cg@60: tz@754: !UIPainterView methodsFor:'grid manipulation'! tz@754: tz@754: newGrid tz@754: "define a new grid - this is a private helper which has to be tz@754: called after any change in the grid. It (re)creates the gridPixmap, tz@754: clears the view and redraws all visible objects." tz@754: tz@754: |defaultViewBackground| tz@754: tz@754: gridPixmap := nil. tz@754: defaultViewBackground := self class defaultViewBackgroundColor. tz@754: tz@754: shown ifTrue:[ sv@3083: self viewBackground: (defaultViewBackground isColor sv@3083: ifTrue: [defaultViewBackground] sv@3083: ifFalse:[self blackColor]). sv@3083: self clear. tz@754: ]. tz@754: tz@754: gridShown ifTrue:[ sv@3083: self defineGrid. sv@3083: gridPixmap colorMap: (defaultViewBackground isColor sv@3083: ifTrue: [Array with:defaultViewBackground with:Color darkGray] sv@3083: ifFalse:[Array with:self whiteColor with:self blackColor]). sv@3083: self viewBackground:gridPixmap. tz@754: ]. tz@754: tz@754: self invalidate tz@754: ! ! tz@754: werner@1832: !UIPainterView methodsFor:'group & ungroup'! werner@1832: werner@1832: group werner@1832: werner@1832: self groupSelectionWithLayout: false werner@1832: ! werner@1832: werner@1832: groupSelectionWithLayout: withLayout ca@2392: |minViews specs spec menu newView target keepLyt keepPos rectangle| ca@2392: ca@2392: self canGroup ifFalse:[^ self ]. ca@2392: ca@2392: keepLyt := withLayout. ca@2392: keepPos := true. werner@1832: werner@1832: menu := Menu new. werner@1832: menu receiver: self. cg@3021: menu addItem:(MenuItem label:'Box' itemValue:[spec := ViewSpec new]). cg@3021: menu addItem:(MenuItem label:'TBox' itemValue:[spec := TBoxSpec new]). cg@3021: menu addItem:(MenuItem label:'FramedBox' itemValue:[spec := FramedBoxSpec new]). cg@3021: cg@3021: menu addItem:(MenuItem cg@3021: label:'HorizontalPanel' cg@3021: itemValue:[ ca@2392: keepLyt := keepPos := false. ca@2392: spec := HorizontalPanelViewSpec new. ca@2392: spec verticalLayout: #fit. ca@2392: spec horizontalLayout: #leftSpace. ca@2392: ]). cg@3021: menu addItem:(MenuItem cg@3021: label:'VerticalPanel' cg@3021: itemValue:[ ca@2392: keepLyt := keepPos := false. ca@2392: spec := VerticalPanelViewSpec new. ca@2392: spec verticalLayout: #topSpace. ca@2392: spec horizontalLayout: #fit. ca@2392: ]). ca@2392: ca@2392: menu startUp. ca@2392: spec isNil ifTrue:[^ self]. ca@2392: ca@2392: minViews := self minClosedViewSetFor:(self selection). ca@2392: minViews size > 1 ifFalse:[^ self]. ca@2392: ca@2392: specs := OrderedCollection new. ca@2392: rectangle := minViews first frame copy. ca@2392: ca@2392: minViews do:[:eachView| ca@2392: specs add:(self fullSpecWithAbsolutePositionFor:eachView). ca@2392: rectangle := rectangle quickMerge:(eachView frame). werner@1832: ]. ca@2392: spec layout:rectangle. ca@2392: ca@2392: target := self findContainerOfView:(minViews first). ca@2392: ca@2392: self withinTransaction:#group objects:(Array with:target) do:[ |widgets| ca@2392: self deleteSelectionBuffered:false. ca@2392: ca@2392: spec otherAttributeAt:#uiPainterAttributes put:(Dictionary new ca@2392: at:#origin put:(rectangle origin); ca@2392: at:#extent put:(rectangle extent); ca@2392: at:#absOrigin put:(rectangle origin); ca@2392: yourself). ca@2392: ca@2392: newView := self pasteSpecifications:(Array with:spec) ca@2392: into:target ca@2392: keepLayout:true ca@2392: keepPosition:true ca@2392: at:#keep. ca@2392: ca@2392: widgets := self pasteSpecifications:specs ca@2392: into:newView ca@2392: keepLayout:keepLyt ca@2392: keepPosition:keepPos ca@2392: at:nil. werner@1832: ]. ca@2392: self select:newView. werner@1832: ! werner@1832: werner@1832: groupWithLayout werner@1832: werner@1832: self groupSelectionWithLayout: true werner@1832: ! werner@1832: werner@1832: ungroup werner@1832: werner@1832: self ungroupSelectionWithLayout: false werner@1832: ! werner@1832: werner@1832: ungroupSelectionWithLayout: withLayout werner@1832: werner@1832: | canvas cS views specs frame view layout superView| werner@1832: ca@2392: self canUngroup ifFalse:[^ self ]. ca@2392: werner@1832: canvas := self painter. werner@1832: cS := canvas getSelectedViewsAndSpecs. werner@1832: cS isNil ifTrue:[^self]. werner@1832: views := cS first first subViews copy. werner@1832: superView := cS first first superView. werner@1832: cS last first component isNil ifTrue:[^self]. werner@1832: cS last first component collection isEmpty ifTrue:[^self]. werner@1834: specs := cS last first component collection copy. werner@1832: frame := cS first first frame. werner@1832: canvas deleteSelection. werner@1832: withLayout ifFalse:[ ca@2392: 1 to: specs size do:[:i| ca@2392: view := views at: i. ca@2392: layout := LayoutFrame leftFraction:0.0 offset: (view origin x + frame origin x) ca@2392: rightFraction:0.0 offset: (view corner x + frame origin x + 1) ca@2392: topFraction:0.0 offset: (view origin y + frame origin y ) ca@2392: bottomFraction:0.0 offset: (view corner y + frame origin y + 1). ca@2392: (specs at: i) layout: layout. ca@2392: ]. werner@1834: ]. werner@1832: canvas selection: superView. werner@1832: canvas pasteSpecifications:specs keepLayout:true. werner@1832: canvas selection: superView. werner@1832: ! werner@1832: werner@1832: ungroupWithLayout werner@1832: werner@1832: self ungroupSelectionWithLayout: true werner@1832: ! ! werner@1832: cg@60: !UIPainterView methodsFor:'initialization'! cg@60: ca@770: create cg@1959: "colors on device" cg@1959: ca@770: super create. cg@3262: handleColorBlack := handleColorBlack onDevice:device. cg@3262: handleColorWhite := handleColorWhite onDevice:device. cg@3262: handleMasterColor := handleMasterColor onDevice:device. ca@770: ! ca@770: cg@60: initialize ca@62: "setup attributes ca@62: " cg@60: super initialize. ca@770: superclassName := 'ApplicationModel'. ca@770: className := 'NewApplication'. ca@770: methodName := 'windowSpec'. ca@770: categoryName := 'Applications'. ca@770: HandCursor := Cursor leftHand. sv@3314: handleColorBlack := self blackColor. sv@3314: handleColorWhite := self whiteColor. ca@770: handleMasterColor := Color red. cg@60: tz@712: self backgroundColor: self class defaultViewBackgroundColor. cg@60: ! cg@60: cg@60: setupFromSpec:specOrSpecArray cg@2197: |spec builder specWindow| cg@60: tz@784: Cursor wait showWhile: [ cg@2197: self removeAll. cg@2197: specOrSpecArray notNil ifTrue:[ cg@2526: spec := UISpecification from:specOrSpecArray. cg@2197: ]. cg@2197: builder := UIBuilder new isEditing:true. cg@2197: "set applicationClass, in order that subspecifications may be resolved" cg@2197: className notNil ifTrue:[ cg@2197: builder applicationClass:(self resolveName:className). cg@2197: ]. cg@2197: spec notNil ifTrue:[ cg@2197: specWindow := spec window. cg@2197: ]. cg@2197: specWindow notNil ifTrue:[ cg@2197: specWindow setupView:self topView for:builder. cg@2197: self addSpec:(spec component) builder:builder in:self. cg@2197: ]. cg@2197: self realizeAllSubViews. cg@2197: specWindow notNil ifTrue:[ cg@2197: treeView setAttributesFromWindowSpec:specWindow cg@2197: ]. ca@1671: ]. ca@223: ! ca@223: ca@223: treeView:aTreeView ca@361: treeView := aTreeView. ca@361: cg@3557: "I want to see the events of the treeView" ca@361: treeView delegate:( cg@3557: "/ cg@3557: "/ I want to handle everything typed cg@3557: "/ in the treeView, except for Return and Cursor-keys cg@3557: "/ cg@3557: KeyboardForwarder cg@3557: toView:self cg@3557: condition:nil cg@3557: filter:[:k | (k isSymbol cg@3557: and:[k ~~ #Return cg@3557: and:[k ~~ #Tab cg@3557: and:[(k startsWith:#Cursor) not]]]) cg@3557: ] ca@361: ) ca@361: cg@376: "Modified: / 31.10.1997 / 20:22:09 / cg" cg@60: ! ! cg@60: cg@60: !UIPainterView methodsFor:'menus'! cg@60: ca@121: showMiddleButtonMenu cg@2191: "show the middle button menu; this returns nil" ca@1635: ca@1635: |m| ca@1635: ca@223: self enabled ifTrue:[ cg@2191: m := MenuPanel fromSpec:(UIPainter menuEdit) receiver:self superView application. cg@2191: self startUpMenu:m ca@111: ]. cg@2191: ^ nil cg@2191: cg@2191: "Modified: / 31-10-2007 / 11:10:10 / cg" cg@60: ! ! cg@60: cg@1714: !UIPainterView methodsFor:'private-handles'! tz@754: werner@1832: painter werner@1832: ^ treeView canvas werner@1832: ! werner@1832: tz@754: showSelected:aComponent tz@754: "show object selected tz@754: " cg@2537: |wasClipped sel hInsideColor hOutsideColor bg| tz@754: tz@754: selectionHiddenLevel == 0 ifTrue:[ cg@2499: sel := treeView selection. cg@2499: (sel size > 1 and: [(treeView model list at: sel first) contents view == aComponent]) cg@2499: ifTrue: [ cg@2537: hInsideColor := handleMasterColor. cg@2499: ] ifFalse:[ cg@2499: bg := aComponent viewBackground. cg@2499: bg isColor ifTrue:[ cg@2499: bg brightness < 0.5 ifTrue:[ cg@2537: hInsideColor := handleColorWhite cg@2499: ] ifFalse:[ cg@2537: hInsideColor := handleColorBlack cg@2499: ] cg@2499: ] ifFalse:[ cg@2537: hInsideColor := handleColorBlack cg@2499: ] cg@2499: ]. cg@2499: cg@2537: hInsideColor brightness < 0.5 ifTrue:[ cg@2537: hOutsideColor := handleColorWhite cg@2537: ] ifFalse:[ cg@2537: hOutsideColor := handleColorBlack cg@2537: ]. cg@2499: cg@2499: (wasClipped := clipChildren) ifTrue:[ cg@3387: gc clippedByChildren:(clipChildren := false). cg@2499: ]. cg@2499: cg@2499: self handlesOf:aComponent do:[:aRectangle :what| cg@2499: |l t w h| cg@2499: cg@2537: l := aRectangle left. cg@2537: t := aRectangle top. cg@2537: w := aRectangle width. cg@2537: h := aRectangle height. cg@2537: cg@3387: gc paint:hOutsideColor. cg@3387: gc displayRectangleX:l y:t width:w height:h. cg@3387: cg@3387: gc paint:hInsideColor. cg@2499: cg@2499: what == #view ifTrue:[ cg@3387: gc displayRectangleX:l+1 y:t+1 width:w-2 height:h-2 cg@2499: ] ifFalse:[ cg@3387: gc fillRectangleX:l+1 y:t+1 width:w-2 height:h-2 cg@2499: ] cg@2499: ]. cg@2499: cg@2499: wasClipped ifTrue:[ cg@3387: gc clippedByChildren:(clipChildren := true). cg@2499: ] tz@754: ] bg@1543: bg@1543: "Modified: / 6.12.2001 / 00:00:16 / cg" tz@754: ! ! tz@754: ca@335: !UIPainterView methodsFor:'queries'! ca@335: cg@2276: isEditingSpecOnly cg@2583: "/ should not be invoked cg@2421: self breakPoint:#ca. cg@2582: ^ false. cg@2276: ! cg@2276: cg@2276: isNotEditingSpecOnly cg@2583: "/ should not be invoked cg@2421: self breakPoint:#ca. cg@2583: ^ true. cg@2276: ! cg@2276: ca@335: resolveName:aName ca@335: |appl| ca@335: ca@335: appl := self application. ca@335: ca@335: appl notNil ifTrue:[ werner@1834: ^ appl resolveName:aName ca@335: ]. ca@335: ^ Smalltalk resolveName:aName inClass:self class ca@335: ! ! ca@335: cg@60: !UIPainterView methodsFor:'removing components'! cg@60: ca@78: remove:anObject ca@78: "remove anObject from the contents do redraw cg@60: " ca@134: anObject notNil ifTrue:[ werner@1834: treeView removeView:anObject. ca@134: ] cg@60: ! cg@60: cg@60: removeAll ca@62: "remove all objects and properties ca@62: " ca@776: self select:nil. ca@776: treeView removeAll. ca@776: self removeUndoHistory. cg@60: ! ! cg@60: cg@60: !UIPainterView methodsFor:'searching'! cg@60: ca@285: findContainerOfView:aView ca@285: "returns the super view assigned to a view ca@89: " ca@285: |p| ca@89: ca@285: (p := self propertyOfParentForView:aView) isNil ifTrue:[ werner@1834: ^ self ca@89: ]. ca@285: ^ p view ca@89: ! ca@89: cg@60: findObjectAt:aPoint ca@285: |view prop| cg@60: cg@60: view := super findObjectAt:aPoint. cg@2499: view isNil ifTrue:[^ nil]. cg@2499: cg@2362: "/ stupid check, if I know about this view ca@1870: prop := self propertyOfView:view. ca@285: prop notNil ifTrue:[^ prop view]. cg@2963: self halt:'nil property'. ca@1870: ^ nil cg@60: ! cg@60: cg@60: findViewWithId:aViewId ca@62: "finds view assigned to identifier and returns the view or nil cg@60: " cg@60: |prop| cg@60: cg@60: prop := self propertyOfIdentifier:aViewId. cg@60: cg@60: prop notNil ifTrue:[^ prop view] werner@1834: ifFalse:[^ nil] ca@78: ! ca@78: ca@78: propertyOfIdentifier:anId ca@78: "returns property assigned to unique identifier ca@78: " ca@78: anId notNil ifTrue:[ werner@1834: ^ treeView propertyDetect:[:p| p identifier == anId ] ca@78: ]. ca@78: ^ nil ca@78: ! ca@78: ca@78: propertyOfName:aString cg@2231: "returns the property for a given widgets name (name in tree)" cg@2231: ca@111: |name| ca@111: ca@111: aString isNil ifFalse:[ cg@2231: name := aString string withoutSeparators. cg@2231: ^ treeView propertyDetect:[:p| p name = name ]. ca@78: ]. ca@78: ^ nil ca@78: ! ca@78: ca@285: propertyOfParentForView:aSubView ca@285: "returns the property of the parent or nil ca@285: " ca@285: |item| ca@285: ca@1870: (item := treeView detectItemCorespondingToView:aSubView) notNil ifTrue:[ ca@1870: (item := item parent) notNil ifTrue:[^ item contents] ca@285: ]. ca@285: ^ nil ca@285: ! ca@285: ca@78: propertyOfView:aView ca@1870: "detect the property for the argument, a view. The property of the view or ca@285: the first subview providing the properties is returned. If no property is detected ca@285: nil is returned. ca@285: " ca@285: |item| ca@285: ca@1870: item := treeView detectItemCorespondingToView:aView. ca@285: (item notNil and:[item parent notNil]) ifTrue:[ ca@1870: ^ item contents ca@285: ]. ca@285: ^ nil ca@285: ! ca@285: ca@111: uniqueNameFor:aSpecOrString cg@2231: "generate and return a unique name for a specClass or an items name. cg@2231: (unique name in the tree)" cg@2231: cg@2231: |maxUsedIndex name nameLen| cg@2231: cg@2231: name := aSpecOrString isString cg@2231: ifFalse:[aSpecOrString userFriendlyName] cg@2231: ifTrue:[aSpecOrString]. cg@2231: cg@2231: nameLen := name size. cg@2231: maxUsedIndex := 0. ca@78: cg@238: treeView propertiesDo:[:p| cg@2231: |thisName| cg@2231: cg@2231: thisName := p name. cg@2231: cg@2231: (thisName size > nameLen and:[thisName startsWith:name]) ifTrue:[ cg@2231: maxUsedIndex := maxUsedIndex max:(p extractNumberStartingAt:nameLen+1) cg@2231: ] ca@78: ]. cg@2231: ^ name, (maxUsedIndex+1) printString. ca@78: ! ca@78: ca@78: uniqueNameOf:aView ca@111: |prop| ca@78: ca@111: (prop := self propertyOfView:aView) notNil ifTrue:[ werner@1834: prop name isNil ifTrue:[ werner@1834: prop name:(self uniqueNameFor:(prop spec)). werner@1834: ]. werner@1834: ^ prop name ca@78: ]. ca@111: ^ 'self' ca@78: cg@60: ! ! cg@60: ca@223: !UIPainterView methodsFor:'selection basics'! ca@223: ca@223: addToSelection:anObject ca@223: "add an object to the selection ca@223: " ca@223: (self enabled and:[(self isSelected:anObject) not]) ifTrue:[ cg@2257: selection isCollection ifFalse:[ cg@2257: selection isNil ifTrue:[ cg@2257: selection := anObject cg@2257: ] ifFalse:[ cg@2257: selection := OrderedCollection with:selection with:anObject cg@2257: ] cg@2257: ] ifTrue:[ cg@2257: "/ to enforce the change-message (value is identical to oldValue) cg@2257: selection isList ifTrue:[ cg@2257: selection add:anObject cg@2257: ] ifFalse:[ cg@2257: selection := selection asOrderedCollection. cg@2257: selection := selection copyWith:anObject cg@2257: ] cg@2257: ]. cg@2257: self showSelected:anObject. cg@2257: treeView canvasSelectionAdd:anObject. ca@223: ] ca@223: cg@1347: "Modified: / 11.2.2000 / 01:39:05 / cg" ca@223: ! ca@223: ca@223: removeFromSelection:anObject ca@223: "remove an object from the selection ca@223: " ca@223: (self isSelected:anObject) ifTrue:[ cg@2257: self showUnselected:anObject. cg@2257: cg@2257: selection size > 1 ifTrue:[ cg@2257: selection isList ifTrue:[ cg@2257: selection remove:anObject ifAbsent:nil cg@2257: ] ifFalse:[ cg@2257: "/ to enforce the change-message (value is identical to oldValue) cg@2257: selection := selection asOrderedCollection. cg@2257: selection := selection copyWithout:anObject cg@2257: ]. cg@2257: self showSelection. cg@2257: ] ifFalse:[ cg@2257: selection := nil cg@2257: ]. cg@2257: treeView canvasSelectionRemove:anObject. ca@223: ] ca@223: cg@1347: "Modified: / 11.2.2000 / 01:41:11 / cg" ca@223: ! ca@223: ca@223: select:something ca@223: "change selection to something werner@1834: " werner@1834: (self enabled and:[something ~= self selection]) ifTrue:[ cg@2257: something isNil cg@2257: ifTrue: [treeView selection: (Array with: 1)] cg@2257: ifFalse:[treeView canvasSelection:something]. cg@2257: self setSelection:something withRedraw:true ca@223: ] ca@223: ! ca@223: werner@1830: selectNextUpInHierarchy werner@1830: | sel | werner@1830: werner@1830: (sel := self selection) isNil ifTrue:[^self]. werner@1830: sel isCollection ifTrue:[ cg@2257: sel := self selection first. werner@1830: ]. werner@1830: sel := sel superView. werner@1830: sel isNil ifTrue:[^self]. cg@2257: treeView canvasSelection: sel. werner@1830: self selection: sel. werner@1830: ! werner@1830: ca@2392: selectedNodes ca@2392: ^ treeView model selectedNodes ca@2392: ! ca@2392: ca@285: updateSelectionFromModel:aSelOrNil ca@223: "update selection from a new selection ca@223: " ca@1427: |list| ca@768: ab@2180: "/ do not return here if not shown - we NEED the correct selection ca@223: selectionHiddenLevel == 0 ifTrue:[ cg@2039: aSelOrNil size ~~ 0 ifTrue:[ cg@2039: list := OrderedCollection new. cg@2039: cg@2039: self selectionDo:[:el| cg@2039: (aSelOrNil includes:el) ifFalse:[list add:el] cg@2039: ]. ab@2180: self shown ifTrue:[self showUnselected:list]. cg@2039: ] ifFalse:[ ab@2180: self shown ifTrue:[self hideSelection]. cg@2039: ] ca@223: ]. cg@2515: self repairDamage. ca@285: self setSelection:aSelOrNil withRedraw:false. cg@2515: self showSelection. ca@223: ! ! ca@223: ca@78: !UIPainterView methodsFor:'specification'! ca@78: ca@78: addSpec:aSpecification builder:aBuilder in:aFrame ca@78: "build view and subviews from aSpecification into a frame. The top view ca@78: is returned. The contained components of a spec are set to nil ca@78: " ca@2390: ^ self addSpec:aSpecification builder:aBuilder in:aFrame beforeIndex:nil. ca@2390: ! ca@2390: ca@2390: addSpec:aSpecification builder:aBuilder in:aFrame beforeIndex:anIndexOrNil ca@2390: "build view and subviews from aSpecification into a frame. The top view ca@2390: is returned. The contained components of a spec are set to nil ca@2390: " ca@2390: |cls newView viewPosition subviewToRealize| cg@212: ca@330: cls := self resolveName:className. ca@330: ca@330: cls notNil ifTrue:[ cg@2226: aBuilder applicationClass:cls. cg@212: ]. ca@78: ca@2390: ( anIndexOrNil notNil ca@2390: and:[anIndexOrNil between:1 and:(aFrame subViews size)] ca@2390: ) ifTrue:[ ca@2390: viewPosition := anIndexOrNil. ca@2390: ]. ca@2390: cg@2229: "/ remember view<->spec associations to tree cg@2499: aBuilder cg@2499: componentCreationHook:[:aView :aSpec :builder| cg@2499: |newProperty copyOfSpec nameOfSpec beforeIndex| cg@2499: cg@2499: (viewPosition notNil and:[aSpecification == aSpec]) ifTrue:[ cg@2499: subviewToRealize := aView. cg@2499: cg@2499: [ (subviewToRealize notNil and:[subviewToRealize superView ~~ aFrame]) ] whileTrue:[ cg@2499: subviewToRealize := subviewToRealize superView. cg@2499: ]. cg@2499: subviewToRealize notNil ifTrue:[ cg@2499: beforeIndex := viewPosition. cg@2499: aFrame changeSequenceOrderFor:subviewToRealize to:viewPosition. cg@2499: ]. ca@2390: ]. cg@2499: cg@2499: newProperty := ViewProperty new. cg@2499: copyOfSpec := aSpec copy. cg@2499: newProperty spec:copyOfSpec. cg@2499: newProperty view:aView. cg@2499: cg@2499: "/ break refs to child-specs cg@2499: "/ (not needed, as we keep the child info in the view hierarchy) cg@2499: copyOfSpec class supportsSubComponents ifTrue:[ cg@2499: copyOfSpec component:nil ca@2390: ]. cg@2499: cg@2499: nameOfSpec := copyOfSpec name. cg@2853: "/ old: enforce a name cg@2853: "/ (nameOfSpec isNil or:[(self propertyOfName:nameOfSpec) notNil]) ifTrue:[ cg@2853: "/ copyOfSpec name:(nameOfSpec := self uniqueNameFor:copyOfSpec) cg@2853: "/ ]. cg@2853: "/ aView name:nameOfSpec. cg@2853: "/ new: cg@2853: (nameOfSpec isNil "notEmptyOrNil" or:[ (self propertyOfName:nameOfSpec) notNil]) ifTrue:[ cg@2853: copyOfSpec name:(nameOfSpec := self uniqueNameFor:copyOfSpec). cg@2853: aView name:nameOfSpec. cg@2499: ]. cg@2853: "/ end cg@2853: cg@2499: treeView addProperty:newProperty beforeIndex:beforeIndex. ca@2390: ]. cg@2231: ca@2390: newView := aSpecification buildViewWithLayoutFor:aBuilder in:aFrame. ca@2390: ca@2390: subviewToRealize notNil ifTrue:[ ca@2390: subviewToRealize realize. ca@2390: cg@2499: aFrame components notEmptyOrNil ifTrue:[ self halt ]. ca@2390: aFrame subViews from:(viewPosition + 1 ) do:[:v| ca@2390: v shown ifTrue:[v raise] ca@2390: ]. ca@2390: ]. ca@2390: ^ newView cg@60: cg@2853: "Modified: / 17-08-2011 / 13:56:24 / cg" ca@78: ! ca@78: cg@2362: fullSpecFor:aView cg@3031: "generate a full spec for aView (or component)" cg@2526: ca@78: |mySpec subSpecs| ca@78: cg@2362: mySpec := self specFor:aView. ca@78: (mySpec notNil and:[mySpec class supportsSubComponents]) ifTrue:[ cg@2505: subSpecs isNil ifTrue:[ cg@2505: subSpecs := OrderedCollection new cg@2505: ]. cg@2505: cg@2505: ((aView components ? #()) , (aView subViews ? #())) do:[:aSubViewOrComponent | cg@2505: |spec| cg@2505: cg@2505: spec := self fullSpecFor:aSubViewOrComponent. cg@2505: spec notNil ifTrue:[ cg@2505: subSpecs add:spec. cg@2362: ]. cg@2505: ]. cg@2505: cg@2505: subSpecs notEmptyOrNil ifTrue:[ cg@2505: mySpec component:(SpecCollection new collection:subSpecs) cg@2362: ] ca@78: ]. ca@78: ^ mySpec cg@3038: cg@3038: "Modified: / 30-07-2013 / 09:12:18 / cg" cg@2362: ! cg@2362: cg@2362: fullSpecWithAbsolutePositionFor:aView cg@2362: |spec| cg@2362: cg@2362: spec := self fullSpecFor:aView. cg@2362: spec cg@2362: otherAttributeAt:#uiPainterAttributes cg@2362: put:(Dictionary new cg@2362: at:#origin put:aView origin; cg@2362: at:#extent put:aView extent; cg@2362: at:#absOrigin put:(aView originRelativeTo:self); cg@2362: yourself). cg@2362: ^ spec cg@60: ! cg@60: cg@1173: rebuildView:aView fromSpec:aSpec withBuilder:aBuilderOrNil cg@2257: self cg@2257: rebuildView:aView fromSpec:aSpec withBuilder:aBuilderOrNil forceNewView:false cg@2257: ! cg@2257: cg@2257: rebuildView:aView fromSpec:aSpec withBuilder:aBuilderOrNil forceNewView:forceNewView cg@1173: |v builder| cg@1173: cg@1173: (builder := aBuilderOrNil) isNil ifTrue:[ cg@2257: "/ create a dummy builder cg@2257: builder := UIBuilder new isEditing:true. cg@2257: className notNil ifTrue:[ cg@2257: builder applicationClass:(self resolveName:className). cg@2257: ]. cg@1173: ]. ca@285: cg@1252: aSpec class isLayoutContainer ifTrue:[ cg@2257: "/ TODO: cg@2257: "/ go through subviews and let them resize to their default/preferred cg@2257: "/ needed if we change a containers layout from fit to non-fit. cg@2257: cg@2257: (aView subViews ? #()) do:[:aSubView | cg@2265: |fix spec prop container| cg@2257: cg@2257: (prop := self propertyOfView:aSubView) notNil ifTrue:[ cg@2257: spec := prop spec. cg@2257: cg@2257: spec useDefaultExtent ifTrue:[ cg@2257: fix := aSubView sizeFixed:false. cg@2265: aView class == VerticalPanelView ifTrue:[ cg@2348: aSubView height:aSubView preferredHeight. cg@2265: ] ifFalse:[ cg@2265: aView class == HorizontalPanelView ifTrue:[ cg@2348: aSubView width:aSubView preferredWidth. cg@2265: ] ifFalse:[ cg@2265: aSubView extent:aSubView preferredExtent. cg@2265: ]. cg@2265: ]. cg@2257: aSubView sizeFixed:fix cg@2257: ] cg@2257: ] cg@2257: ]. cg@1252: ]. cg@1252: cg@2257: (forceNewView or:[aSpec needsRebuildForAttributes]) ifTrue:[ cg@2257: "/ needs a full rebuild (in case view class depends upon spec-attribute) cg@2257: v := aSpec buildViewWithLayoutFor:builder in:(self findContainerOfView:aView). cg@2257: v realize. cg@2257: aView destroy. sv@3083: self sync. cg@2257: aView becomeSameAs:v. cg@2257: "/ inputView raise. ca@285: ] ifFalse:[ cg@2257: aSpec setAttributesIn:aView with:builder. cg@2257: self elementChangedSize:aView. ca@285: ]. ca@285: ! ca@285: cg@2362: specFor:aView cg@2362: "returns a copy of the spec assigned to an object" cg@2362: ca@78: |prop spec| cg@60: cg@2362: (prop := self propertyOfView:aView) isNil ifTrue:[^ nil]. cg@3038: "/ attention: the above prop may be a superview's prop, cg@3038: "/ for subviews which have not been built by me cg@3038: "/ (for example, in a box with a given viewClass like Inspector, cg@3038: "/ we would return the boxes spec for the subviews. cg@3038: "/ This is definitely NOT what we want (as it generates wrong specs). cg@3038: "/ therefore check: cg@3038: prop view == aView ifFalse:[^ nil]. cg@2362: cg@1744: spec := prop spec copy. cg@2362: spec layoutFromView:aView. ca@78: ^ spec cg@3038: cg@3038: "Modified (comment): / 30-07-2013 / 09:47:51 / cg" cg@60: ! cg@60: ca@146: specForSelection cg@2526: "returns the spec assigned to current single selection or nil. cg@2526: Nil is also returned for multiple selections (sigh)" cg@2526: cg@2526: |theSpec| cg@2526: cg@2526: theSpec := self specFor:(self singleSelection). cg@2526: theSpec isNil ifTrue:[ cg@2526: treeView isCanvasSelected ifTrue:[ cg@2526: theSpec := treeView canvasSpec. cg@2526: ] cg@2526: ]. cg@2526: ^ theSpec ca@146: ! ca@146: ca@78: updateFromSpec:aSpec ca@78: "update current selected view from specification ca@62: " cg@1173: |props name| ca@78: ca@281: aSpec class == WindowSpec ifTrue:[ cg@2499: ^ treeView canvasSpec:aSpec ca@281: ]. ca@281: ca@78: self singleSelection notNil ifTrue:[ cg@2499: self withSelectionHiddenDo:[ cg@2499: self transaction:#specification selectionDo:[:aView| cg@2853: cg@2499: props := self propertyOfView:aView. cg@2499: name := (aSpec name) withoutSeparators. cg@2499: cg@2853: name isNil ifTrue:[ cg@2853: "/ not yet given a name cg@2853: (name ~= props name) ifTrue:[ cg@2853: (self propertyOfName:name) notNil ifTrue:[ cg@2853: name := props name cg@2853: ] cg@2853: ]. cg@2499: ]. cg@2499: aSpec name:name. cg@2499: self createUndoSpecModify:props. cg@2499: self rebuildView:aView fromSpec:aSpec withBuilder:nil. cg@2499: props spec:(aSpec copy). cg@2499: treeView propertyChanged:props. cg@2499: ] cg@2499: ] ca@82: ] cg@212: cg@2853: "Modified: / 17-08-2011 / 13:56:38 / cg" cg@2853: "Modified (format): / 18-08-2011 / 02:19:01 / cg" cg@60: ! ! cg@60: ca@285: !UIPainterView methodsFor:'testing'! ca@285: ca@285: canChangeLayoutOfView:aView cg@2362: "returns true if the view can change its layout. cg@2362: This is dependent on its parent view." cg@2362: sv@2483: |item parent| cg@2362: cg@2362: item := treeView itemOfView:aView. cg@2362: item isNil ifTrue:[ cg@3348: "/ I don't know anything about that view (cg: how can this happen ?) cg@2362: "/ self breakPoint:#cg. cg@2362: ^ false ca@285: ]. cg@2362: parent := item parent. cg@2362: parent isNil ifTrue:[ cg@2362: "/ that view has no parent (cg: does this mean its the canvas itself ?) cg@2362: "/ self breakPoint:#cg. cg@2362: ^ false cg@2362: ]. sv@2483: parent contents view == self ifTrue:[ sv@2483: "aView is a direct subview of the canvas sv@2483: -- and the canvas supports layout changes of its subviews" sv@2483: ^ true. cg@2362: ]. sv@2480: ^ parent contents spec class isLayoutContainer not ca@285: ! ca@285: cg@1230: canExchangeSelectionLayouts cg@1230: "returns true if the selection size is exactly 2 cg@1230: and all elements in the selection can be moved or aligned cg@1230: " sv@2480: selection size ~~ 2 ifTrue:[ sv@2480: ^ false cg@1230: ]. cg@1230: ^ self canMoveOrAlignSelection cg@1230: ! cg@1230: ca@2392: canGroup ca@2392: "test whether selected elements can be grouped; minimum two elements ca@2392: must be selected and all must have the same parent" ca@2392: ca@2392: |selectedNodes parent| ca@2392: ca@2392: selectedNodes := self selectedNodes. ca@2392: ca@2392: selectedNodes size < 2ifTrue:[ ^ false ]. ca@2392: ca@2392: parent := selectedNodes first parent. ca@2392: parent isNil ifTrue:[ ^ false ]. "/ test whether not the canvas itself is selected ca@2392: ca@2392: selectedNodes do:[:each| ca@2392: each parent ~~ parent ifTrue:[^ false ]. ca@2392: ]. ca@2392: ca@2392: ^true ca@2392: ! ca@2392: ca@285: canKeepLayoutInSelection ca@285: "returns true if layout can be kept during a paste operation ca@285: " ca@285: |prop| ca@285: ca@285: prop := self propertyOfView:(self singleSelection). ca@285: ^ (prop isNil or:[prop spec class isLayoutContainer not]) ca@285: ! ca@285: ca@285: canMove:something ca@285: "checks whether something is not nil and if all widgets derived from ca@285: something can change their layout ( move, align, ... operation ). ca@285: " ca@285: something notNil ifTrue:[ sv@3554: something doIfNotNil:[:aView| cg@2362: (self canChangeLayoutOfView:aView) ifFalse:[^ false] cg@2362: ]. cg@2362: ^ true ca@285: ]. ca@285: ^ false sv@3554: sv@3554: "Modified: / 11-04-2018 / 18:19:47 / stefan" ca@285: ! ca@285: ca@285: canMoveOrAlignSelection ca@285: "returns true if a selection exists and all elements in the selection ca@285: can be moved or aligned ca@285: " cg@2362: ^ self canMove:(self selection) ca@2392: ! ca@2392: sv@2480: canResize:something sv@2480: "checks whether something is not nil and if all widgets derived from sv@2480: something can be resized." sv@2480: sv@2480: something notNil ifTrue:[ sv@3554: something doIfNotNil:[:aView| sv@2480: (self canResizeView:aView) ifFalse:[^ false] sv@2480: ]. sv@2480: ^ true sv@2480: ]. sv@2480: ^ false sv@3554: sv@3554: "Modified: / 11-04-2018 / 18:20:09 / stefan" sv@2480: ! sv@2480: sv@2480: canResizeSelection sv@2480: "returns true if a selection exists and all elements in the selection sv@2480: can be resized" sv@2480: sv@2480: ^ self canResize:(self selection) sv@2480: ! sv@2480: sv@2480: canResizeView:aView sv@2480: "returns true if the view can be resized. sv@2480: This is dependent on its parent view." sv@2480: sv@2480: |item parent| sv@2480: sv@2480: item := treeView itemOfView:aView. sv@2480: item isNil ifTrue:[ cg@3348: "/ I don't know anything about that view (cg: how can this happen ?) sv@2480: "/ self breakPoint:#cg. sv@2480: ^ false sv@2480: ]. sv@2480: parent := item parent. sv@2480: parent isNil ifTrue:[ sv@2480: "/ that view has no parent (cg: does this mean its the canvas itself ?) sv@2480: "/ self breakPoint:#cg. sv@2480: ^ false sv@2480: ]. sv@2483: parent contents view == self ifTrue:[ sv@2483: "aView is a direct subview of the canvas sv@2483: -- and the canvas supports resizing of its subviews" sv@2483: ^ true. sv@2483: ]. sv@2480: ^ parent contents spec class canResizeSubComponents sv@2480: ! sv@2480: ca@2392: canUngroup ca@2392: "test whether the selected element can be ungrouped; only one ca@2392: element is selected and has children" ca@2392: ca@2392: "/ the #ungroupSelectionWithLayout: dosnot work yet - so disable ca@2392: ca@2392: "/ |selectedNodes node| ca@2392: "/ ca@2392: "/ selectedNodes := self selectedNodes. ca@2392: "/ ca@2392: "/ ca@2392: "/ selectedNodes size == 1 ifTrue:[ ca@2392: "/ node := selectedNodes first. ca@2392: "/ node parent isNil ifTrue:[ ^ false ]. "/ test whether not the canvas itself is selected ca@2392: "/ ca@2392: "/ ^ node hasChildren ca@2392: "/ ]. ca@2392: ^ false ca@285: ! ! ca@285: cg@60: !UIPainterView methodsFor:'transaction'! cg@60: cg@60: transaction:aType objects:something do:aOneArgBlock cg@60: "opens a transaction and evaluates a block within the transaction; the cg@60: argument to the block is a view from derived from something cg@60: " ca@134: self withinTransaction:aType objects:something do:[ sv@3554: something doIfNotNil:aOneArgBlock cg@60: ] sv@3554: sv@3554: "Modified: / 11-04-2018 / 18:20:27 / stefan" cg@60: ! cg@60: cg@1954: withinTransaction:aType objects:objects do:aNoArgBlock cg@2362: "evaluate a block within a transaction" cg@2362: ca@134: |text size prop| ca@134: ca@134: objects isNil ifTrue:[ ^ self ]. ca@134: ca@134: size := objects size. cg@60: ca@134: objects isCollection ifTrue:[ cg@1954: size == 0 ifTrue:[ ^ self ]. cg@2362: size == 1 ifTrue:[ cg@2362: prop := self propertyOfView:(objects first) cg@2362: ] ca@134: ] ifFalse:[ cg@1954: prop := self propertyOfView:objects ca@134: ]. cg@60: ca@134: prop notNil ifTrue:[ cg@1954: text := prop name ca@134: ] ifFalse:[ cg@1954: text := size printString, ' elements' cg@60: ]. ca@134: cg@1954: undoHistory withinTransaction:aType text:text do:aNoArgBlock. cg@1954: self undoHistoryChanged. cg@60: ! ! cg@60: cg@60: !UIPainterView methodsFor:'undo actions'! cg@60: ca@134: createUndoLayout:aView cg@3474: "create undo action before changing a view's layout" cg@2509: ca@134: |lyt args prop| cg@60: cg@60: undoHistory isTransactionOpen ifTrue:[ cg@1954: prop := self propertyOfView:aView. cg@1954: cg@1954: prop notNil ifTrue:[ cg@1954: args := Array new:3. cg@1954: args at:1 put:(prop identifier). cg@1954: cg@1954: (lyt := aView geometryLayout) notNil ifTrue:[ cg@1954: args at:2 put:#geometryLayout: cg@1954: ] ifFalse:[ cg@1954: lyt := aView extent. cg@1954: args at:2 put:#extent: cg@1954: ]. cg@1954: args at:3 put:(lyt copy). cg@1954: undoHistory addUndoSelector:#undoLayout: withArgs:args. cg@1954: self undoHistoryChanged. cg@1954: ] cg@60: ] cg@3474: cg@3474: "Modified (comment): / 31-08-2017 / 20:17:23 / cg" cg@60: ! cg@60: ca@134: createUndoRemove:aView ca@134: "create undo method before deleting views cg@60: " ca@2390: |item itemParent prop args| ca@2390: ca@2390: item := treeView detectItemCorespondingToView:aView. ca@2390: item isNil ifTrue:[^ self ]. ca@2390: ca@2390: itemParent := item parent. ca@2390: itemParent isNil ifTrue:[^ self ]. ca@2390: ca@2390: prop := item contents. ca@2390: ca@2390: args := Array ca@2390: with:(self fullSpecFor:aView) ca@2390: with:(prop identifier) ca@2390: with:(itemParent contents identifier) ca@2390: with:(itemParent indexOfChild:item). ca@2390: ca@2390: ca@2390: undoHistory addUndoSelector:#'undoRemove:' withArgs:args. ca@2390: self undoHistoryChanged. ca@134: ! cg@60: ca@134: createUndoSpecModify:aProp ca@134: "undo method when changing the specification for an object ca@134: " ca@134: aProp notNil ifTrue:[ cg@1954: undoHistory addUndoSelector:#undoSpecModify: cg@1954: withArgs:(Array with:(aProp spec) with:(aProp identifier)). cg@1954: self undoHistoryChanged. ca@134: ] ca@134: ! cg@60: cg@2509: createUndoStartPointEndPoint:aComponent cg@2509: "create an undo action before changing aComponent" cg@2509: cg@2509: |args prop| cg@2509: cg@2509: undoHistory isTransactionOpen ifTrue:[ cg@2509: prop := self propertyOfView:aComponent. cg@2509: cg@2509: prop notNil ifTrue:[ cg@2509: args := Array new:4. cg@2509: args at:1 put:(prop identifier). cg@2509: args at:2 put:#'startPoint:endPoint:'. cg@2509: args at:3 put:(aComponent startPoint). cg@2509: args at:4 put:(aComponent endPoint). cg@2509: undoHistory addUndoSelector:#undoStartPointEndPoint: withArgs:args. cg@2509: self undoHistoryChanged. cg@2509: ] cg@2509: ] cg@2509: ! cg@2509: ca@134: undoCreate:something sv@3554: "undo method for creating or pasting an object" sv@3554: sv@3554: something doIfNotNil:[:anId|self remove:(self findViewWithId:anId)]. sv@3554: sv@3554: "Modified: / 11-04-2018 / 18:20:46 / stefan" ca@134: ! cg@60: cg@1520: undoHistory cg@1520: ^ undoHistory cg@1520: cg@1520: "Created: / 30.10.2001 / 13:42:45 / cg" cg@1520: ! cg@1520: ca@134: undoLayout:args ca@134: "undo method to set the old layout; see 'createUndoLayout:' ca@134: " ca@134: |view| ca@134: ca@134: (view := self findViewWithId:(args at:1)) notNil ifTrue:[ sv@2480: view perform:(args at:2) with:(args at:3). sv@2480: self elementChangedSize:view. sv@2480: self layoutChanged. cg@60: ] cg@60: ! cg@60: ca@134: undoRemove:args ca@134: "undo method when removing an object; see 'createUndoRemove:' ca@134: " ca@2390: |frame prop view position parentId| ca@2390: ca@2390: position := args at:4 ifAbsent:nil. ca@2390: parentId := args at:3 ifAbsent:nil. ca@2390: ca@2390: parentId notNil ifTrue:[ ca@2390: frame := self findViewWithId:parentId. ca@134: ]. ca@2390: ca@2390: frame isNil ifTrue:[ frame := self. ]. ca@2390: ca@2390: view := self addSpec:(args at:1) ca@2390: builder:(UIBuilder new isEditing:true) ca@2390: in:frame ca@2390: beforeIndex:position. ca@2390: ca@134: view realize. ca@134: prop := self propertyOfView:view. ca@134: prop identifier:(args at:2). ca@134: ! ca@134: ca@134: undoSpecModify:args ca@134: "undo method when changing a spec; see 'createUndoSpecModify:' cg@60: " cg@1173: |view spec props| cg@60: ca@134: props := self propertyOfIdentifier:(args at:2). cg@60: ca@134: props notNil ifTrue:[ werner@1834: view := props view. werner@1834: spec := args at:1. werner@1834: werner@1834: props spec:spec. werner@1834: self rebuildView:view fromSpec:spec withBuilder:nil. werner@1834: treeView propertyChanged:props. cg@211: ] cg@2509: ! cg@2509: cg@2509: undoStartPointEndPoint:args cg@2509: "undo method to set the old start/endPoint; see 'createUndoStartPointEndPoint:' cg@2509: " cg@2509: |view| cg@2509: cg@2509: (view := self findViewWithId:(args at:1)) notNil ifTrue:[ cg@2509: view perform:(args at:2) with:(args at:3) with:(args at:4). cg@2509: self elementChangedSize:view. cg@2509: self layoutChanged. cg@2509: ] cg@211: ! ! cg@211: cg@211: !UIPainterView::ViewProperty class methodsFor:'instance creation'! cg@211: cg@211: new cg@211: Identifier notNil ifTrue:[Identifier := Identifier + 1] werner@1834: ifFalse:[Identifier := 1]. cg@211: cg@211: ^ self basicNew initialize cg@211: ! ! cg@211: cg@211: !UIPainterView::ViewProperty methodsFor:'accessing'! cg@211: cg@211: identifier cg@211: "return the unique identifier assigned to property cg@211: " cg@211: ^ identifier cg@211: ! cg@211: cg@211: identifier:anIdentifier cg@211: "set the unique identifier assigned to property; called after an restore of cg@211: a deleted instance cg@211: " cg@211: identifier := anIdentifier cg@211: ! cg@211: cg@211: spec cg@211: "return the value of the instance variable 'spec' (automatically generated)" cg@211: ca@1427: ^ spec ca@1427: ! cg@211: cg@211: spec:something cg@211: "set the value of the instance variable 'spec' (automatically generated)" cg@211: ca@1427: spec := something. ca@1427: ! cg@211: cg@211: view cg@211: "return the value of the instance variable 'view' (automatically generated)" cg@211: ca@1427: ^ view ca@1427: ! cg@211: cg@211: view:something cg@211: "set the value of the instance variable 'view' (automatically generated)" cg@211: ca@1427: view := something. ca@1427: ! ! cg@211: cg@211: !UIPainterView::ViewProperty methodsFor:'initialization'! cg@211: cg@211: initialize cg@211: super initialize. cg@211: identifier := Identifier cg@211: ! ! cg@211: cg@211: !UIPainterView::ViewProperty methodsFor:'misc'! cg@211: cg@211: extractNumberStartingAt:anIndex cg@2231: "return the number from the name starting at anIndex (or 0 if there is no number)." cg@2231: cg@2231: "/ cg: code cleanup. cg@2231: ^ Integer cg@2231: readFrom:(self name readStream skip:(anIndex-1)) cg@2231: onError:0 cg@2231: cg@2231: "/ |val| cg@2231: "/ cg@2231: "/ val := 0. cg@2231: "/ cg@2231: "/ self name from:anIndex do:[:c| cg@2231: "/ c isDigit ifTrue:[val := val * 10 + c digitValue] cg@2231: "/ ifFalse:[^ 0] cg@2231: "/ ]. cg@2231: "/ ^ val cg@2231: cg@211: " cg@2231: (self basicNew spec:(ButtonSpec new name:'button12')) extractNumberStartingAt:7 cg@2231: " cg@211: ! ! cg@211: cg@211: !UIPainterView::ViewProperty methodsFor:'spec messages'! cg@211: cg@211: doesNotUnderstand:aMessage cg@211: spec notNil ifTrue:[ cg@3287: (spec respondsTo:(aMessage selector)) ifTrue:[^ aMessage sendTo:spec] cg@211: ]. cg@3287: ('[UIPainter::ViewProperty] warning: message ignored: ',aMessage selector) errorPrintCR. cg@211: ^ nil cg@211: ! cg@211: cg@211: layout ca@1664: ^ spec layout cg@211: ! cg@211: cg@211: layout:aLayout cg@211: spec layout:aLayout cg@211: ! cg@211: cg@211: name cg@211: ^ spec name cg@211: ! cg@211: cg@211: name:aName cg@211: spec name:aName cg@211: ! ! cg@211: cg@60: !UIPainterView class methodsFor:'documentation'! cg@60: cg@60: version cg@60: ^ '$Header$' cg@2627: ! cg@2627: cg@2627: version_CVS cg@2627: ^ '$Header$' cg@60: ! ! tm@1621: cg@2951: sv@1225: UIPainterView initialize!