diff -r a00f1446c10b -r c6699a14d3d9 UIPainterView.st --- a/UIPainterView.st Wed May 21 12:40:05 1997 +0200 +++ b/UIPainterView.st Wed May 21 12:41:01 1997 +0200 @@ -11,7 +11,7 @@ " UIObjectView subclass:#UIPainterView - instanceVariableNames:'viewProperties superclassName className methodName categoryName' + instanceVariableNames:'listHolder superclassName className methodName categoryName' classVariableNames:'HandCursor' poolDictionaries:'' category:'Interface-UIPainter' @@ -31,6 +31,13 @@ privateIn:UIPainterView ! +MultiSelectionInList subclass:#ListHolder + instanceVariableNames:'painter propertyList masterElement disabledChanged' + classVariableNames:'' + poolDictionaries:'' + privateIn:UIPainterView +! + !UIPainterView class methodsFor:'documentation'! copyright @@ -63,6 +70,167 @@ ! ! +!UIPainterView class methodsFor:'menu specs'! + +menu + + ^ #(#Menu #( + #(#MenuItem + #'label:' 'copy' + #'nameKey:' #copySelection + #'shortcutKeyCharacter:' #Copy + ) + #(#MenuItem + #'label:' 'cut' + #'nameKey:' #deleteSelection + #'shortcutKeyCharacter:' #Cut + ) + #(#MenuItem + #'label:' 'paste' + #'nameKey:' #paste + #'submenu:' + #(#Menu #( + #(#MenuItem + #'label:' 'paste' + #'nameKey:' #pasteBuffer + #'shortcutKeyCharacter:' #Paste + ) + #(#MenuItem + #'label:' 'keep layout' + #'nameKey:' #pasteWithLayout + ) + ) + nil + nil + ) + ) + #(#MenuItem + #'label:' 'undo' + #'nameKey:' #undoLast) + #(#MenuItem + #'label:' 'arrange' + #'nameKey:' #arrange + #'submenu:' + #(#Menu #( + #(#MenuItem + #'label:' 'to front' + #'nameKey:' #raiseSelection + ) + #(#MenuItem + #'label:' 'to back' + #'nameKey:' #lowerSelection + ) + ) + nil + nil + ) + ) + #(#MenuItem + #'label:' 'dimension' + #'nameKey:' #dimension + #'submenu:' + #(#Menu #( + #(#MenuItem + #'label:' 'default extent' + #'nameKey:' #setToDefaultExtent + ) + #(#MenuItem + #'label:' 'default width' + #'nameKey:' #setToDefaultWidth + ) + #(#MenuItem + #'label:' 'default height' + #'nameKey:' #setToDefaultHeight + ) + #(#MenuItem + #'label:' 'copy extent' + #'nameKey:' #copyExtent + ) + #(#MenuItem + #'label:' 'paste extent' + #'nameKey:' #pasteExtent + ) + #(#MenuItem + #'label:' 'paste width' + #'nameKey:' #pasteWidth + ) + #(#MenuItem + #'label:' 'paste height' + #'nameKey:' #pasteHeight + ) + #(#MenuItem + #'label:' 'copy layout' + #'nameKey:' #copyLayout + ) + #(#MenuItem + #'label:' 'paste layout' + #'nameKey:' #pasteLayout + ) + ) + #(3 1 3) + nil + ) + ) + #(#MenuItem + #'label:' 'align' + #'nameKey:' #align + #'submenu:' + #(#Menu #( + #(#MenuItem + #'label:' 'align left' + #'nameKey:' #alignSelectionLeft + ) + #(#MenuItem + #'label:' 'align right' + #'nameKey:' #alignSelectionRight + ) + #(#MenuItem + #'label:' 'align left & right' + #'nameKey:' #alignSelectionLeftAndRight + ) + #(#MenuItem + #'label:' 'align top' + #'nameKey:' #alignSelectionTop + ) + #(#MenuItem + #'label:' 'align bottom' #'nameKey:' + #alignSelectionBottom + ) + #(#MenuItem + #'label:' 'align centered vertical' + #'nameKey:' #alignSelectionCenterHor + ) + #(#MenuItem + #'label:' 'align centered horizontal' + #'nameKey:' #alignSelectionCenterVer + ) + #(#MenuItem + #'label:' 'spread horizontal' + #'nameKey:' #spreadSelectionHor + ) + #(#MenuItem + #'label:' 'spread vertical' + #'nameKey:' #spreadSelectionVer + ) + #(#MenuItem + #'label:' 'center horizontal in frame' + #'nameKey:' #centerSelectionHor + ) + #(#MenuItem + #'label:' 'center vertical in frame' + #'nameKey:' #centerSelectionVer + ) + ) + #(7 2) + nil + ) + ) + ) + #(4) + nil + ) +! ! + !UIPainterView methodsFor:'accessing'! application @@ -95,6 +263,10 @@ ! +listHolder + ^ listHolder +! + methodName ^ methodName ! @@ -134,6 +306,55 @@ ! ! +!UIPainterView methodsFor:'change & update'! + +changed:aParameter + aParameter == #layout ifTrue:[ + listHolder removeDependent:self. + listHolder changed:aParameter. + listHolder addDependent:self. + ] ifFalse:[ + super changed:aParameter + ] +! + +selectionChanged + "selection has changed + " + |newSel| + + selection notNil ifTrue:[ + self selectionDo:[:aView||p| + (p := self propertyOfView:aView) notNil ifTrue:[ + newSel isNil ifTrue:[ + newSel := OrderedCollection new + ]. + newSel add:(listHolder indexOfName:(p name)) + ] + ] + ]. + listHolder removeDependent:self. + listHolder selectionIndex:newSel. + listHolder addDependent:self. +! + +update:what with:aParm from:aSender + |loIdx newSel| + + (what == #selectionIndex and:[aSender == listHolder]) ifFalse:[ + ^ self + ]. + loIdx := listHolder selectionIndex. + + loIdx size ~~ 0 ifTrue:[ + newSel := loIdx collect:[:i|(listHolder propertyAt:i) view] + ]. + self withSelectionHiddenDo:[ + selection := newSel + ]. + +! ! + !UIPainterView methodsFor:'copy & cut & paste'! copySelection @@ -161,21 +382,21 @@ coll := self minSetOfSuperViews:selection. coll notNil ifTrue:[ - self unselect. - specs := coll collect:[:aView| self fullSpecFor:aView ]. - text := self transactionTextFor:coll. + listHolder disableNotificationsWhileEvaluating:[ + self unselect. + specs := coll collect:[:aView| self fullSpecFor:aView ]. + text := self transactionTextFor:coll. - undoHistory transaction:#cut text:text do:[ - coll reverseDo:[:o||p| - (p := self propertyOfView:o) notNil ifTrue:[ - self undoRemove:(p identifier) - ]. - self remove:o - ] - ]. - - self setSelection:specs. - self changed:#tree. + undoHistory transaction:#cut text:text do:[ + coll reverseDo:[:o||p| + (p := self propertyOfView:o) notNil ifTrue:[ + self undoRemove:(p identifier) + ]. + self remove:o + ] + ]. + self setSelection:specs. + ] ] ! @@ -189,7 +410,7 @@ pasteSpecifications:aSpecificationOrList keepLayout:keepLayout "add the specs to the object view " - |paste frame pasteOrigin pasteOffset builder| + |paste frame pasteOrigin pasteOffset builder newSel| (self canPaste:aSpecificationOrList) ifFalse:[ ^ self @@ -206,8 +427,8 @@ ]. self unselect. - selection := OrderedCollection new. - builder := UIBuilder new. + newSel := OrderedCollection new. + builder := UIBuilder new. keepLayout ifFalse:[ pasteOffset := 0@0. @@ -215,36 +436,35 @@ pasteOrigin := device translatePoint:pasteOrigin from:device rootView id to:frame id. ]. - paste do:[:aSpec| - |view| + listHolder disableNotificationsWhileEvaluating:[ + paste do:[:aSpec| + |view| - view := self addSpec:aSpec builder:builder in:frame. + view := self addSpec:aSpec builder:builder in:frame. - keepLayout ifFalse:[ - (frame bounds containsPoint:pasteOrigin) ifFalse:[ - self moveObject:view to:pasteOffset. - ] ifTrue:[ - self moveObject:view to:pasteOrigin + pasteOffset. + keepLayout ifFalse:[ + (frame bounds containsPoint:pasteOrigin) ifFalse:[ + self moveObject:view to:pasteOffset. + ] ifTrue:[ + self moveObject:view to:pasteOrigin + pasteOffset. + ]. + pasteOffset := pasteOffset + 4 ]. - pasteOffset := pasteOffset + 4 + view realize. + newSel add:view. ]. - view realize. - selection add:view. ]. - self transaction:#paste selectionDo:[:v| + self transaction:#paste objects:newSel do:[:v| self undoCreate:((self propertyOfView:v) identifier) ]. - selection size == 1 ifTrue:[ - selection := selection at:1 + newSel size == 1 ifTrue:[ + newSel := newSel at:1 ]. - self showSelection. self realizeAllSubViews. inputView raise. + self select:newSel. self elementChangedSize:frame. - self changed:#tree - - "Modified: 8.4.1997 / 01:08:15 / cg" ! pasteWithLayout @@ -317,7 +537,7 @@ ]. cls := Smalltalk classNamed:className. - viewProperties do:[:aProp | + listHolder propertiesDo:[:aProp | |modelSelector menuSelector protoSpec thisCode| (modelSelector := aProp model) notNil ifTrue:[ @@ -340,7 +560,17 @@ thisCode := (self generateAspectMethodFor:menuSelector spec:protoSpec inClass:cls). code := code , thisCode ] - ] + ]. + + aProp spec aspectSelectors do:[:aSel| + (cls implements:aSel asSymbol) ifFalse:[ + protoSpec := aProp view specClass basicNew. + "/ kludge .. + thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). + code := code , thisCode + ] + ]. + ]. ^ code @@ -421,7 +651,7 @@ "generate code for groups" - viewProperties do:[:props | + listHolder propertiesDo:[:props| g := props at:#group ifAbsent:[nil]. g notNil ifTrue:[ code := code , (self generateInitCodeForGroup:g) @@ -618,7 +848,7 @@ ! storeContentsOn:aStream - viewProperties do:[:p| p storeOn:aStream] + listHolder propertiesDo:[:p| p storeOn:aStream] ! subviewsOf:aView do:aBlock @@ -627,7 +857,7 @@ (subs := aView subViews) notNil ifTrue:[ subs do:[:v| (v ~~ inputView and:[v notNil]) ifTrue:[ - (viewProperties detect:[:p | p view == v] ifNone:nil) notNil ifTrue:[ + (listHolder detectProperty:[:p|p view == v]) notNil ifTrue:[ (v superView == aView) ifTrue:[ aBlock value:v ] @@ -653,13 +883,13 @@ self withSelectionHiddenDo:[ group := EnterFieldGroup new. props := GroupProperties new. - name := self uniqueNameFor:EnterFieldGroup. + name := self uniqueNameFor:(EnterFieldGroup className). props group:group. props name:name. group groupID:name asSymbol. objects := OrderedCollection new. props controlledObjects:objects. - viewProperties add:props. + listHolder add:props. self selectionDo:[:aView | objects add:aView. @@ -683,13 +913,13 @@ self withSelectionHiddenDo:[ group := RadioButtonGroup new. props := GroupProperties new. - name := self uniqueNameFor:RadioButtonGroup. + name := self uniqueNameFor:(RadioButtonGroup className). props group:group. props name:name. group groupID:name asSymbol. objects := OrderedCollection new. props controlledObjects:objects. - viewProperties add:props. + listHolder add:props. self selectionDo:[:aView | aView turnOff. @@ -712,10 +942,9 @@ className := 'NewApplication'. methodName := 'windowSpec'. categoryName := 'Applications'. - viewProperties := OrderedCollection new. + listHolder := ListHolder for:self. HandCursor := Cursor leftHand. - "Modified: 5.9.1995 / 19:58:06 / claus" ! initializeCreatedObject:anObject @@ -728,8 +957,8 @@ props := ViewProperty new. props view:anObject. props spec:spec. - props name:(self uniqueNameFor:cls). - viewProperties add:props. + props name:(self uniqueNameFor:spec). + listHolder add:props. ((spec respondsTo:#label:) and:[self supportsLabel:anObject]) ifTrue:[ anObject label:(props name). @@ -744,15 +973,15 @@ setupFromSpec:specOrSpecArray |spec builder| - self removeAll. - - spec := UISpecification from:specOrSpecArray. - builder := UIBuilder new. - spec window setupView:self topView for:builder. - self addSpec:(spec component) builder:builder in:self. - self realizeAllSubViews. - inputView raise. - self changed:#tree. + listHolder disableNotificationsWhileEvaluating:[ + self removeAll. + spec := UISpecification from:specOrSpecArray. + builder := UIBuilder new. + spec window setupView:self topView for:builder. + self addSpec:(spec component) builder:builder in:self. + self realizeAllSubViews. + inputView raise. + ] ! ! !UIPainterView methodsFor:'menus'! @@ -760,67 +989,25 @@ menu "returns middle-button menu dependent on the selection " - |menu canPaste undoIdx undoText| + |menu canPaste| testMode ifTrue:[^ nil ]. + menu := MenuPanel fromSpec:(self class menu) receiver:self. canPaste := self canPaste:(self getSelection). - undoText := undoHistory lastTypeAsString. selection isNil ifTrue:[ - undoIdx := 2. - - menu := PopUpMenu labels:( resources array:#('paste' 'undo') ) - selectors:#( #paste #undoLast ) - receiver:self - ] ifFalse:[ - undoIdx := 4. - - menu := PopUpMenu labels:( resources array:#( - 'copy' - 'cut' - 'paste' - 'undo' - '-' - 'arrange' - 'dimension' - 'align' - ) - ) - selectors:#( #copySelection - #deleteSelection - #paste - #undoLast - nil - #arrange - #dimension - #align - ) - accelerators:#(#Copy - #Cut - nil - nil - nil - nil - nil - nil - ) - receiver:self. - - canPaste := (canPaste and:[self canPasteInto:selection]). - menu subMenuAt:#arrange put:(self subMenuArrange). - menu subMenuAt:#dimension put:(self subMenuDimension). - menu subMenuAt:#align put:(self subMenuAlign). + menu disableAll + ] ifFalse:[ + canPaste := (canPaste and:[self canPasteInto:selection]) + ]. + menu enabledAt:#paste put:[|can| + can := self canPaste:(self getSelection). + selection isNil ifTrue:[can] + ifFalse:[(can and:[self canPasteInto:selection])] ]. - menu subMenuAt:#paste put:(self subMenuPaste). - canPaste ifFalse:[menu disable:#paste]. - - undoText notNil ifTrue:[ - menu labelAt:undoIdx put:((menu labels at:undoIdx), ': ', undoText) - ] ifFalse:[ - menu disable:#undoLast - ]. + menu enabledAt:#undoLast put:(undoHistory notEmpty). ^ menu @@ -843,154 +1030,6 @@ ] "Modified: 10.4.1997 / 10:06:15 / cg" -! - -subMenuAlign - "returns submenu alignment - " - |menu| - - menu := PopUpMenu labels:( - resources array:#( - 'align left' - 'align right' - 'align left & right' - 'align top' - 'align bottom' - 'align centered vertical' - 'align centered horizontal' - '-' - 'spread horizontal' - 'spread vertical' - '-' - 'center horizontal in frame' - 'center vertical in frame' - ) - ) - - selectors:#( - alignSelectionLeft - alignSelectionRight - alignSelectionLeftAndRight - alignSelectionTop - alignSelectionBottom - alignSelectionCenterHor - alignSelectionCenterVer - nil - spreadSelectionHor - spreadSelectionVer - nil - centerSelectionHor - centerSelectionVer - ) - receiver:self. - ^ menu - -! - -subMenuArrange - "returns submenu arrange - " - |menu| - - menu := PopUpMenu labels:( - resources array:#( - 'to front' - 'to back' - ) - ) - selectors:#( - raiseSelection - lowerSelection - ) - receiver:self. - ^ menu -! - -subMenuDimension - "returns submenu dimension - " - |menu| - - menu := PopUpMenu labels:( - resources array:#( - 'default extent' - 'default width' - 'default height' - '-' - 'copy extent' - '-' - 'paste extent' - 'paste width' - 'paste height' - '-' - 'copy layout' - 'paste layout' - ) - ) - selectors:#( - setToDefaultExtent - setToDefaultWidth - setToDefaultHeight - nil - copyExtent - nil - pasteExtent - pasteWidth - pasteHeight - nil - copyLayout - pasteLayout - ) - receiver:self. - ^ menu -! - -subMenuFont - "returns submenu dimension - " - |menu| - - menu := PopUpMenu labels:( - resources array:#( - 'larger' - 'smaller' - '-' - 'normal' - 'bold' - 'italic' - 'bold italic' - '-' - 'font panel' - ) - ) - selectors:#( - largerFont - smallerFont - nil - normalFont - boldFont - italicFont - boldItalicFont - nil - showFontPanel - ) - receiver:self. - ^ menu -! - -subMenuPaste - "returns submenu Paste - " - |menu| - - menu := PopUpMenu labels:( resources array:#('paste' 'keep layout') ) - selectors:#( #pasteBuffer #pasteWithLayout ) - accelerators:#( #Paste nil ) - receiver:self. - - ^ menu - ! ! !UIPainterView methodsFor:'misc'! @@ -1011,7 +1050,6 @@ self elementChangedSize:aView. ] ]. - self changed:#any. ] "Modified: 5.9.1995 / 12:13:27 / claus" @@ -1032,8 +1070,7 @@ aView font:f. self elementChangedSize:aView. ] - ]. - self changed:#any. + ] ] "Modified: 5.9.1995 / 12:13:27 / claus" @@ -1044,36 +1081,17 @@ remove:anObject "remove anObject from the contents do redraw " - |props| - - anObject notNil ifTrue:[ - (anObject subViews notNil) ifTrue:[ - anObject subViews copy do:[:sub | - self remove:sub - ] - ]. - (props := self propertyOfView:anObject) notNil ifTrue:[ - viewProperties remove:props ifAbsent:nil - ]. - anObject destroy - ] + listHolder remove:anObject. ! removeAll "remove all objects and properties " - self unselect. - viewProperties := OrderedCollection new. - - subViews notNil ifTrue:[ - subViews copy do:[:sub | - sub ~~ inputView ifTrue:[ - self remove:sub - ] - ] - ]. - undoHistory reinitialize. - self changed:#tree + listHolder disableNotificationsWhileEvaluating:[ + self unselect. + listHolder removeAll. + undoHistory reinitialize. + ] ! ! !UIPainterView methodsFor:'searching'! @@ -1127,14 +1145,14 @@ propertyOfGroup:aGroup "returns property assigned to group " - ^ viewProperties detect:[:p| p group == aGroup] ifNone:nil + ^ listHolder detectProperty:[:p| p group == aGroup ] ! propertyOfIdentifier:anId "returns property assigned to unique identifier " anId notNil ifTrue:[ - ^ viewProperties detect:[:p| p identifier == anId] ifNone:nil. + ^ listHolder detectProperty:[:p| p identifier == anId ] ]. ^ nil ! @@ -1142,8 +1160,14 @@ propertyOfName:aString "returns property assigned to name " - aString = 'self' ifFalse:[ - ^ viewProperties detect:[:p| p name = aString] ifNone:nil + |name| + + aString isNil ifFalse:[ + name := aString string withoutSeparators. + + name = 'self' ifFalse:[ + ^ listHolder detectProperty:[:p| p name = name ]. + ] ]. ^ nil ! @@ -1152,23 +1176,30 @@ "returns property assigned to view " (aView isNil or:[aView == self]) ifFalse:[ - ^ viewProperties detect:[:p| p view == aView] ifNone:nil + ^ listHolder detectProperty:[:p| p view == aView ] ]. ^ nil ! -uniqueNameFor:aClass +uniqueNameFor:aSpecOrString "generate and return an unique name for a class " |next name size| - next := 0. - name := aClass name asString copy. - size := name size + 1. + aSpecOrString isString ifFalse:[name := aSpecOrString className asString] + ifTrue:[name := aSpecOrString]. + (name endsWith:'Spec') ifTrue:[ + name := name copyFrom:1 to:(name size - 4). + ] ifFalse:[ + name := name copy + ]. name at:1 put:(name at:1) asLowercase. + size := name size + 1. + next := 0. - viewProperties do:[:p||n| + listHolder propertiesDo:[:p| + |n| n := p name. (n size >= size and:[n startsWith:name]) ifTrue:[ @@ -1184,19 +1215,15 @@ ! uniqueNameOf:aView - |name prop| + |prop| - aView notNil ifTrue:[ - prop := self propertyOfView:aView + (prop := self propertyOfView:aView) notNil ifTrue:[ + prop name isNil ifTrue:[ + prop name:(self uniqueNameFor:(prop spec)). + ]. + ^ prop name ]. - prop isNil ifTrue:[ - ^ 'self' - ]. - (name := prop name) isNil ifTrue:[ - name := self uniqueNameFor:(aView class). - prop name:name. - ]. - ^ name + ^ 'self' ! ! @@ -1241,7 +1268,7 @@ self withSelectionHiddenDo:[ selection := aCollection ]. - self changed:#selection + self selectionChanged ] ! ! @@ -1253,7 +1280,7 @@ " aBuilder applicationClass:(Smalltalk classNamed:className). - aBuilder componentCreationHook:[:aView :aSpec :aBdr||sv p s| + aBuilder componentCreationHook:[:aView :aSpec :aBdr||sv p s n| p := ViewProperty new. s := aSpec copy. p spec:s. @@ -1263,10 +1290,12 @@ s component:nil ]. - (self propertyOfName:(s name)) notNil ifTrue:[ - s name:(self uniqueNameFor:(aView class)) + n := s name. + + (n isNil or:[(self propertyOfName:n) notNil]) ifTrue:[ + s name:(self uniqueNameFor:s) ]. - viewProperties add:p + listHolder add:p ]. ^ aSpecification buildViewWithLayoutFor:aBuilder in:aFrame. @@ -1351,11 +1380,10 @@ aSpec setAttributesIn:aView with:builder. self elementChangedSize:aView. ]. - props spec:(aSpec copy). + listHolder propertyChanged:props. ] - ]. - self changed:#tree + ] ] ! ! @@ -1556,6 +1584,7 @@ spec setAttributesIn:view with:builder. self elementChangedSize:view. ]. + listHolder propertyChanged:props. ] ] ]. @@ -1696,6 +1725,342 @@ name := aName ! ! +!UIPainterView::ListHolder class methodsFor:'instance creation'! + +for:aPainter + ^ self new for:aPainter +! ! + +!UIPainterView::ListHolder methodsFor:'accessing'! + +canModify + ^ (painter notNil and:[painter testMode not]) +! + +painter + "returns painter + " + ^ painter +! + +propertyAt:anIndex + "returns property at an index + " + ^ propertyList at:anIndex +! ! + +!UIPainterView::ListHolder methodsFor:'adding & removing'! + +add:aProperty + "add property and update list + " + |idx list name last| + + list := self list. + idx := self findParentProperty:aProperty. + name := aProperty name. + + idx == 0 ifTrue:[ + last := list size + ] ifFalse:[ + last := self lastInGroupStartingAt:idx. + name := (String new:(4+((list at:idx) leftIndent))), name. + ]. + propertyList add:aProperty afterIndex:last. + list add:name afterIndex:last. + self changed:#size + + +! + +remove:aView + "remove all view relevant resources + " + |start| + + aView notNil ifTrue:[ + start := self findProperty:[:p| p view == aView ]. + + start ~~ 0 ifTrue:[ + self basicRemove:start. + self changed:#size. + ] + ] +! + +removeAll + masterElement := nil. + self selection:#(). + + [propertyList notEmpty] whileTrue:[ + self basicRemove:1 + ]. + self changed:#size. + +! ! + +!UIPainterView::ListHolder methodsFor:'change & update'! + +changed:aParameter + "notify all dependents that the receiver has changed somehow. + Each dependent gets a '#update:'-message with aParameter + as argument. In case of disabled no notifications are raised + " + disabledChanged ifFalse:[ + super changed:aParameter + ] +! + +disableNotificationsWhileEvaluating:aBlock + "perform block without notification; after evaluation of block, + a #size changed notification is raised + " + |oldState| + + oldState := disabledChanged. + disabledChanged := true. + aBlock value. + disabledChanged := oldState. + self changed:#size. +! + +propertyChanged:aProperty + "property list changed; update list names + " + |list idx oldName newName wspName view indent mid| + + view := aProperty view. + idx := self findProperty:[:p| p view == view ]. + + idx == 0 ifTrue:[ + ^ self error + ]. + + list := self list. + oldName := list at:idx. + wspName := oldName string withoutSeparators. + newName := aProperty name. + + wspName = newName ifFalse:[ + mid := self masterElement. + list at:idx put:((String new:(oldName leftIndent)), newName). + + idx == mid ifTrue:[ + masterElement := nil. + self masterElement:idx + ]. + ]. + self changed:#property + +! ! + +!UIPainterView::ListHolder methodsFor:'enumerating'! + +propertiesDo:aBlock + "evaluate a block for each property + " + propertyList do:aBlock +! ! + +!UIPainterView::ListHolder methodsFor:'initialization'! + +for:aPainter + "initialize for a painter + " + self list:(OrderedCollection new). + propertyList := OrderedCollection new. + self selection:#(). + disabledChanged := false. + painter := aPainter. + self addDependent:painter. + + +! ! + +!UIPainterView::ListHolder methodsFor:'private'! + +basicRemove:start + "remove all resources assigned to a group starting at start; + no notifications are raised + " + |end view superView| + + end := self lastInGroupStartingAt:start. + view := (propertyList at:start) view. + + view notNil ifTrue:[ + superView := view superView. + view destroy. + superView sizeChanged:nil. + ]. + + propertyList removeFromIndex:start toIndex:end. + self list removeFromIndex:start toIndex:end. +! + +masterElement + "returns index of master + " + ^ self indexOfName:masterElement. +! + +masterElement:newIndex + "change master of selection + " + |name list oldIdx| + + (oldIdx := self masterElement) ~~ newIndex ifTrue:[ + list := self list. + + oldIdx ~~ 0 ifTrue:[ + list at:oldIdx put:masterElement + ]. + newIndex ~~ 0 ifTrue:[ + masterElement := list at:newIndex. + name := Text string:masterElement. + name emphasizeFrom:(1+(name leftIndent)) with:#(#bold #underline). + list at:newIndex put:name. + ] ifFalse:[ + masterElement := nil + ]. + self changed:#list. + ] +! ! + +!UIPainterView::ListHolder methodsFor:'searching'! + +detectProperty:aBlock + "find the property, for which evaluation of the argument, aBlock + returns true; return the property or nil if none detected + " + |idx| + + idx := self findProperty:aBlock. + idx ~~ 0 ifTrue:[ ^ propertyList at:idx ]. + ^ nil +! + +findParentProperty:aChildProp + "returns index of parent or 0 + " + |view index| + + view := aChildProp view. + + view notNil ifTrue:[ + [ (view := view superView) notNil ] whileTrue:[ + index := self findProperty:[:aProp| aProp view == view ]. + index ~~ 0 ifTrue:[ + ^ index + ] + ] + ]. + ^ 0 + + +! + +findProperty:aBlock + "find the first property, for which evaluation of the argument, aBlock + returns true; return its index or 0 if none detected + " + ^ propertyList findFirst:aBlock +! + +indexOfName:aString + "returns index assigned to a string or 0 + " + |name list size| + + aString notNil ifTrue:[ + name := aString string withoutSeparators. + size := name size. + list := self list. + + list keysAndValuesDo:[:anIndex :aName| + |el| + + el := aName string. + (el endsWith:name) ifTrue:[ + (el size - el leftIndent) == name size ifTrue:[ + ^ anIndex + ] + ] + ] + ]. + ^ 0 + +! + +lastInGroupStartingAt:start + "returns last index of a group + " + |end list idt| + + list := self list. + + start < list size ifTrue:[ + idt := (list at:start) leftIndent. + end := list findFirst:[:el|(el leftIndent) <= idt] startingAt:(start+1). + end ~~ 0 ifTrue:[ + ^ end - 1 + ] + ]. + ^ list size +! ! + +!UIPainterView::ListHolder methodsFor:'selection'! + +selectGroup + "select all elements assigned to master + " + |start end sel size| + + self canModify ifTrue:[ + (start := self masterElement) ~~ 0 ifTrue:[ + end := self lastInGroupStartingAt:start. + size := end - start + 1. + sel := Array new:size. + + 1 to:size do:[:i| + sel at:i put:start. + start := start + 1 + ]. + self selectionIndex:sel. + ] ifFalse:[ + (self selectionIndex) size == 0 ifFalse:[ + self selectionIndex:#() + ]. + ] + ] +! + +selectedProperty + "returns current selected instance; in case of multiple selection + or no selection nil is returned + " + |selection| + selection := self selectionIndex. + + selection size == 1 ifTrue:[ + ^ propertyList at:(selection at:1) + ]. + ^ nil +! + +selectionIndex:aList + |masterIndex aSel| + + self canModify ifTrue:[aSel := aList] + ifFalse:[aSel := nil]. + + aSel size ~~ 0 ifTrue:[masterIndex := aSel at:1] + ifFalse:[masterIndex := 0]. + + self masterElement:masterIndex. + super selectionIndex:aSel +! ! + !UIPainterView class methodsFor:'documentation'! version