'From Squeak3.1alpha of 5 February 2001 [latest update: #3815] on 8 March 2001 at 7:42:16 pm'! "Change Set: buttonProperties Date: 8 March 2001 Author: Bob Arning The beginnings of a property editor to impart button-like behavior to any morph."! Object subclass: #ButtonProperties instanceVariableNames: 'target actionSelector arguments actWhen wantsRolloverIndicator mouseDownTime nextTimeToFire visibleMorph delayBetweenFirings mouseOverHaloWidth mouseOverHaloColor mouseDownHaloWidth mouseDownHaloColor ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Buttons'! !ButtonProperties commentStamp: '' prior: 0! ButtonProperties test1 ButtonProperties test2 ButtonProperties test3 ! ButtonProperties class instanceVariableNames: ''! AlignmentMorphBob1 subclass: #GenericPropertiesMorph instanceVariableNames: 'myTarget thingsToRevert ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Experimental'! GenericPropertiesMorph subclass: #ButtonPropertiesMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Experimental'! !ButtonPropertiesMorph commentStamp: '' prior: 0! ButtonPropertiesMorph basicNew targetMorph: self; initialize; openNearTarget! GenericPropertiesMorph subclass: #ObjectPropertiesMorph instanceVariableNames: 'targetMorph revertSteps ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Experimental'! !ButtonProperties methodsFor: 'initialization' stamp: 'sma 3/24/2000 11:49'! adaptToWorld: aWorld super adaptToWorld: aWorld. target isMorph ifTrue: [target isWorldMorph ifTrue: [self target: aWorld]. target isHandMorph ifTrue: [self target: aWorld primaryHand]] ifFalse: [(target isKindOf: Presenter) ifTrue: [self target: aWorld presenter]]! ! !ButtonProperties methodsFor: 'initialization' stamp: 'RAA 3/8/2001 15:52'! initialize wantsRolloverIndicator _ false. delayBetweenFirings _ nil. mouseOverHaloWidth _ 10. mouseOverHaloColor _ Color blue alpha: 0.3. mouseDownHaloWidth _ 15. mouseDownHaloColor _ Color blue alpha: 0.7.! ! !ButtonProperties methodsFor: 'menu' stamp: 'sw 9/28/1999 20:42'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. self addLabelItemsTo: aCustomMenu hand: aHandMorph. (target isKindOf: BookMorph) ifTrue: [aCustomMenu add: 'set page sound' action: #setPageSound:. aCustomMenu add: 'set page visual' action: #setPageVisual:] ifFalse: [aCustomMenu add: 'change action selector' action: #setActionSelector. aCustomMenu add: 'change arguments' action: #setArguments. aCustomMenu add: 'change when to act' action: #setActWhen. ((self world rootMorphsAt: aHandMorph targetOffset) size > 1) ifTrue: [aCustomMenu add: 'set target' action: #setTarget:]]. ! ! !ButtonProperties methodsFor: 'menu' stamp: 'sw 9/28/1999 20:41'! addLabelItemsTo: aCustomMenu hand: aHandMorph aCustomMenu add: 'change label' action: #setLabel ! ! !ButtonProperties methodsFor: 'menu' stamp: 'RAA 3/8/2001 07:56'! setActWhen actWhen _ (SelectionMenu selections: #(mouseDown mouseUp mouseStillDown)) startUpWithCaption: 'Choose one of the following conditions' ! ! !ButtonProperties methodsFor: 'menu'! setActionSelector | newSel | newSel _ FillInTheBlank request: 'Please type the selector to be sent to the target when this button is pressed' initialAnswer: actionSelector. newSel isEmpty ifFalse: [self actionSelector: newSel]. ! ! !ButtonProperties methodsFor: 'menu'! setArguments | s newArgs newArgsArray | s _ WriteStream on: ''. arguments do: [:arg | arg printOn: s. s nextPutAll: '. ']. newArgs _ FillInTheBlank request: 'Please type the arguments to be sent to the target when this button is pressed separated by periods' initialAnswer: s contents. newArgs isEmpty ifFalse: [ newArgsArray _ Compiler evaluate: '{', newArgs, '}' for: self logged: false. self arguments: newArgsArray]. ! ! !ButtonProperties methodsFor: 'menu'! setLabel | newLabel | newLabel _ FillInTheBlank request: 'Please a new label for this button' initialAnswer: self label. newLabel isEmpty ifFalse: [self label: newLabel]. ! ! !ButtonProperties methodsFor: 'menu' stamp: 'di 12/20/1998 16:55'! setPageSound: event ^ target menuPageSoundFor: self event: event! ! !ButtonProperties methodsFor: 'menu' stamp: 'di 12/20/1998 16:55'! setPageVisual: event ^ target menuPageVisualFor: self event: event! ! !ButtonProperties methodsFor: 'menu'! setTarget: evt | rootMorphs | rootMorphs _ self world rootMorphsAt: evt hand targetOffset. rootMorphs size > 1 ifTrue: [target _ rootMorphs at: 2] ifFalse: [target _ nil. ^ self]. ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'sw 10/8/2000 08:14'! actWhen "acceptable symbols: #buttonDown, #buttonUp, and #whilePressed" ^ actWhen! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 15:42'! actWhen: condition "Accepts symbols: #buttonDown, #buttonUp, and #whilePressed" (#(buttonDown mouseDown) includes: condition) ifTrue: [ actWhen _ #mouseDown ]. (#(buttonUp mouseUp) includes: condition) ifTrue: [ actWhen _ #mouseUp ]. (#(whilePressed mouseStillDown) includes: condition) ifTrue: [ actWhen _ #mouseStillDown ]. self setEventHandlers: true.! ! !ButtonProperties methodsFor: 'accessing'! actionSelector ^ actionSelector ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 08:46'! actionSelector: aSymbolOrString aSymbolOrString isEmptyOrNil ifTrue: [^actionSelector _ nil]. aSymbolOrString = 'nil' ifTrue: [^actionSelector _ nil]. actionSelector _ aSymbolOrString asSymbol. ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 17:36'! addTextToButton: aStringOrText | tm existing | existing _ visibleMorph submorphsSatisfying: [ :x | x hasProperty: #textAddedByButtonProperties ]. existing do: [ :x | x delete]. aStringOrText ifNil: [^self]. tm _ TextMorph new contents: aStringOrText. tm fullBounds; lock; align: tm center with: visibleMorph center; setProperty: #textAddedByButtonProperties toValue: true; setToAdhereToEdge: #center. visibleMorph extent: (tm extent * 1.5) rounded. visibleMorph addMorphFront: tm. ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 07:35'! adjustPositionsAfterSizeChange "re-center label, etc??"! ! !ButtonProperties methodsFor: 'accessing'! arguments ^ arguments ! ! !ButtonProperties methodsFor: 'accessing'! arguments: aCollection arguments _ aCollection asArray copy. ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 17:41'! currentTextInButton | existing | existing _ visibleMorph submorphsSatisfying: [ :x | x hasProperty: #textAddedByButtonProperties ]. existing isEmpty ifTrue: [^nil]. ^existing first ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 07:35'! extent: newExtent super extent: newExtent. self adjustPositionsAfterSizeChange. "=== submorphs size = 1 ifTrue: [ label _ self firstSubmorph. label position: self center - (label extent // 2)] ==="! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 07:36'! fitContents | | "=== aCenter _ self center. submorphs size = 0 ifTrue: [^ self]. aMorph _ submorphs first. self extent: aMorph extent + (borderWidth + 6). self center: aCenter. aMorph position: aCenter - (aMorph extent // 2) ==="! ! !ButtonProperties methodsFor: 'accessing'! label | s | s _ ''. self allMorphsDo: [:m | (m isKindOf: StringMorph) ifTrue: [s _ m contents]]. ^ s! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 07:37'! label: aString | | "==== (oldLabel _ self findA: StringMorph) ifNotNil: [oldLabel delete]. m _ StringMorph contents: aString font: TextStyle defaultFont. self extent: m extent + (borderWidth + 6). m position: self center - (m extent // 2). self addMorph: m. m lock ===="! ! !ButtonProperties methodsFor: 'accessing' stamp: 'sw 12/10/1999 09:06'! label: aString font: aFont | oldLabel m | (oldLabel _ self findA: StringMorph) ifNotNil: [oldLabel delete]. m _ StringMorph contents: aString font: (aFont ifNil: [Preferences standardButtonFont]). self extent: (m width + 6) @ (m height + 6). m position: self center - (m extent // 2). self addMorph: m. m lock ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'sw 6/11/1999 18:40'! labelString: aString | existingLabel | (existingLabel _ self findA: StringMorph) ifNil: [self label: aString] ifNotNil: [existingLabel contents: aString. self fitContents] ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 16:15'! mouseDownHaloColor ^mouseDownHaloColor! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 16:15'! mouseDownHaloColor: x mouseDownHaloColor _ x! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 16:31'! mouseDownHaloWidth ^mouseDownHaloWidth! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 16:31'! mouseDownHaloWidth: x mouseDownHaloWidth _ x! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 16:16'! mouseOverHaloColor ^mouseOverHaloColor! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 16:16'! mouseOverHaloColor: x mouseOverHaloColor _ x! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 16:30'! mouseOverHaloWidth ^mouseOverHaloWidth! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 16:31'! mouseOverHaloWidth: x mouseOverHaloWidth _ x! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 15:42'! setEventHandlers: enabled enabled ifTrue: [ visibleMorph on: #mouseDown send: #mouseDown: to: self. visibleMorph on: #mouseStillDown send: #mouseStillDown: to: self. visibleMorph on: #mouseUp send: #mouseUp: to: self. ] ifFalse: [ visibleMorph on: #mouseDown send: nil to: nil. visibleMorph on: #mouseStillDown send: nil to: nil. visibleMorph on: #mouseUp send: nil to: nil. ]. ! ! !ButtonProperties methodsFor: 'accessing'! target ^ target ! ! !ButtonProperties methodsFor: 'accessing'! target: anObject target _ anObject ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 15:43'! visibleMorph: x visibleMorph ifNotNil: [self setEventHandlers: false]. visibleMorph _ x. visibleMorph ifNotNil: [self setEventHandlers: true]. ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 09:09'! wantsRolloverIndicator ^wantsRolloverIndicator ifNil: [false]! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/8/2001 09:14'! wantsRolloverIndicator: aBoolean wantsRolloverIndicator _ aBoolean. wantsRolloverIndicator ifTrue: [ visibleMorph on: #mouseEnter send: #mouseEnter: to: self. visibleMorph on: #mouseLeave send: #mouseLeave: to: self. ].! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/8/2001 09:29'! delayBetweenFirings ^delayBetweenFirings! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/8/2001 09:55'! delayBetweenFirings: millisecondsOrNil delayBetweenFirings _ millisecondsOrNil! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/8/2001 08:33'! doButtonAction "Perform the action of this button. Subclasses may override this method. The default behavior is to send the button's actionSelector to its target object with its arguments." target ifNil: [^self]. actionSelector ifNil: [^self]. Cursor normal showWhile: [ target perform: actionSelector withArguments: (arguments ifNil: [#()]) ]! ! !ButtonProperties methodsFor: 'events' stamp: 'sw 8/16/97 22:10'! handlesMouseDown: evt ^ self isPartsDonor not ! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/8/2001 15:52'! mouseDown: evt mouseDownTime _ Time millisecondClockValue. nextTimeToFire _ nil. delayBetweenFirings ifNotNil: [ nextTimeToFire _ mouseDownTime + delayBetweenFirings. ]. self wantsRolloverIndicator ifTrue: [ visibleMorph addMouseActionIndicatorsWidth: mouseDownHaloWidth color: mouseDownHaloColor. ]. "===== aMorph . now _ Time millisecondClockValue. oldColor _ color. actWhen == #buttonDown ifTrue: [self doButtonAction] ifFalse: [ self updateVisualState: evt; refreshWorld]. dt _ Time millisecondClockValue - now max: 0. dt < 200 ifTrue: [(Delay forMilliseconds: 200-dt) wait]. self mouseStillDown: evt. ====="! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/8/2001 15:52'! mouseEnter: evt self wantsRolloverIndicator ifTrue: [ visibleMorph addMouseActionIndicatorsWidth: mouseOverHaloWidth color: mouseOverHaloColor. ]. ! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/8/2001 09:08'! mouseLeave: evt visibleMorph deleteAnyMouseActionIndicators. ! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/8/2001 07:57'! mouseMove: evt actWhen == #mouseDown ifTrue: [^ self]. self updateVisualState: evt.! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/8/2001 12:22'! mouseStillDown: evt (visibleMorph containsPoint: evt cursorPoint) ifFalse: [^self]. nextTimeToFire ifNil: [^self]. nextTimeToFire <= Time millisecondClockValue ifTrue: [ self doButtonAction. nextTimeToFire _ Time millisecondClockValue + self delayBetweenFirings. ^self ]. ! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/8/2001 14:24'! mouseUp: evt visibleMorph deleteAnyMouseActionIndicators. mouseDownTime _ nextTimeToFire _ nil. actWhen == #mouseUp ifFalse: [^self]. (visibleMorph containsPoint: evt cursorPoint) ifFalse: [^self]. self doButtonAction.! ! !ButtonProperties methodsFor: 'copying' stamp: 'jm 7/28/97 11:52'! updateReferencesUsing: aDictionary "If the arguments array points at a morph we are copying, then point at the new copy. And also copies the array, which is important!!" super updateReferencesUsing: aDictionary. arguments _ arguments collect: [:old | aDictionary at: old ifAbsent: [old]]. ! ! !ButtonProperties methodsFor: 'copying' stamp: 'tk 1/6/1999 17:55'! veryDeepFixupWith: deepCopier "If target and arguments fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!" super veryDeepFixupWith: deepCopier. target _ deepCopier references at: target ifAbsent: [target]. arguments _ arguments collect: [:each | deepCopier references at: each ifAbsent: [each]]. ! ! !ButtonProperties methodsFor: 'copying' stamp: 'RAA 3/8/2001 16:14'! veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment." super veryDeepInner: deepCopier. "target _ target. Weakly copied" "actionSelector _ actionSelector. a Symbol" "arguments _ arguments. All weakly copied" actWhen _ actWhen veryDeepCopyWith: deepCopier. "oldColor _ oldColor veryDeepCopyWith: deepCopier." visibleMorph _ visibleMorph veryDeepCopyWith: deepCopier. delayBetweenFirings _ delayBetweenFirings. mouseDownHaloColor _ mouseDownHaloColor.! ! !ButtonProperties methodsFor: 'fileIn/Out' stamp: 'RAA 3/8/2001 07:33'! objectForDataStream: refStrm "I am about to be written on an object file. If I send a message to a BookMorph, it would be bad to write that object out. Create and write out a URLMorph instead." | bb thatPage um stem ind sqPg | self halt. self flag: #bob. "not ready yet" (actionSelector == #goToPageMorph:fromBookmark:) | (actionSelector == #goToPageMorph:) ifFalse: [ ^ super objectForDataStream: refStrm]. "normal case" target url ifNil: ["Later force target book to get a url." bb _ ButtonProperties new. "write out a dummy" bb label: self label. "bb bounds: bounds." refStrm replace: self with: bb. ^ bb]. (thatPage _ arguments first) url ifNil: [ "Need to assign a url to a page that will be written later. It might have bookmarks too. Don't want to recurse deeply. Have that page write out a dummy morph to save its url on the server." stem _ target getStemUrl. "know it has one" ind _ target pages identityIndexOf: thatPage. thatPage reserveUrl: stem,(ind printString),'.sp']. um _ URLMorph newForURL: thatPage url. sqPg _ thatPage sqkPage clone. sqPg contentsMorph: nil. um setURL: thatPage url page: sqPg. (SqueakPage stemUrl: target url) = (SqueakPage stemUrl: thatPage url) ifTrue: [um book: true] ifFalse: [um book: target url]. "remember which book" "um privateOwner: owner. um bounds: bounds. um isBookmark: true; label: self label." "um borderWidth: borderWidth; borderColor: borderColor." "um color: color." refStrm replace: self with: um. ^ um! ! !ButtonProperties methodsFor: 'visual properties' stamp: 'RAA 3/8/2001 14:24'! updateVisualState: evt " oldColor ifNil: [^self]. self color: ((self containsPoint: evt cursorPoint) ifTrue: [oldColor mixed: 1/2 with: Color white] ifFalse: [oldColor])"! ! !ButtonProperties class methodsFor: 'as yet unclassified' stamp: 'sw 2/6/2001 23:54'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #((button ( (command fire 'trigger any and all of this object''s button actions')))) ! ! !ButtonProperties class methodsFor: 'as yet unclassified' stamp: 'sw 5/6/1998 14:07'! authoringPrototype ^ super authoringPrototype label: 'Button'! ! !ButtonProperties class methodsFor: 'as yet unclassified' stamp: 'sw 2/16/98 01:31'! defaultNameStemForInstances ^ 'button'! ! !ButtonProperties class methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:29'! ellipticalButtonWithText: aStringOrText | m prop | m _ EllipseMorph new. prop _ m ensuredButtonProperties. prop target: #(1 2 3); actionSelector: #inspect; actWhen: #mouseUp; addTextToButton: aStringOrText; wantsRolloverIndicator: true. ^m! ! !ButtonProperties class methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:26'! new ^super new initialize! ! !ButtonProperties class methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 08:31'! test1 | m prop | m _ EllipseMorph new. prop _ m ensuredButtonProperties. prop target: #(1 2 3); actionSelector: #inspect; actWhen: #mouseUp. m openInWorld.! ! !ButtonProperties class methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 08:41'! test2 (self ellipticalButtonWithText: 'Hello world') openInWorld.! ! !ButtonProperties class methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 12:21'! test3 | m | (m _ self ellipticalButtonWithText: 'Hello world') openInWorld. m ensuredButtonProperties target: 1; actionSelector: #beep; delayBetweenFirings: 1000.! ! !Morph methodsFor: 'meta-actions' stamp: 'RAA 3/8/2001 17:42'! openAButtonPropertySheet ButtonPropertiesMorph basicNew targetMorph: self; initialize; openNearTarget! ! !Morph methodsFor: 'button properties' stamp: 'RAA 3/8/2001 14:45'! buttonProperties ^self valueOfProperty: #universalButtonProperties! ! !Morph methodsFor: 'button properties' stamp: 'RAA 3/8/2001 14:45'! buttonProperties: propertiesOrNil propertiesOrNil ifNil: [ self removeProperty: #universalButtonProperties ] ifNotNil: [ self setProperty: #universalButtonProperties toValue: propertiesOrNil ].! ! !Morph methodsFor: 'button properties' stamp: 'RAA 3/8/2001 07:49'! ensuredButtonProperties self hasButtonProperties ifFalse: [ self buttonProperties: (ButtonProperties new visibleMorph: self) ]. ^self buttonProperties! ! !Morph methodsFor: 'button properties' stamp: 'RAA 3/8/2001 07:18'! hasButtonProperties ^self hasProperty: #universalButtonProperties! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:23'! addARow: anArray ^(super addARow: anArray) cellPositioning: #topLeft! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:40'! buildFakeSlider: nameString selector: aSymbol help: helpString | col | col _ self inAColumn: { self lockedString: nameString. }. col borderWidth: 2; borderColor: color darker; color: color muchLighter; hResizing: #shrinkWrap; setBalloonText: helpString; on: #mouseMove send: #mouseAdjust:in: to: self; on: #mouseDown send: #mouseAdjust:in: to: self; on: #mouseUp send: #clearSliderFeedback to: self; setProperty: #changeSelector toValue: aSymbol. ^col ! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 14:35'! buttonNamed: aString action: aSymbol color: aColor help: helpString | f col | f _ SimpleButtonMorph new target: self; label: aString; color: aColor; actionSelector: aSymbol; setBalloonText: helpString. col _ (self inAColumn: {f}) hResizing: #shrinkWrap. ^col! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:41'! clearSliderFeedback | feedBack | feedBack _ self valueOfProperty: #sliderFeedback ifAbsent: [^self]. feedBack delete! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:15'! colorPickerFor: target getter: getterSymbol setter: setterSymbol ^ColorPickerMorph new initializeForPropertiesPanel; target: target; selector: setterSymbol; originalColor: (target perform: getterSymbol)! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 14:36'! directToggleButtonFor: target getter: getterSymbol setter: setterSymbol help: helpText ^(EtoyUpdatingThreePhaseButtonMorph checkBox) target: target; actionSelector: setterSymbol; arguments: #(); getSelector: getterSymbol; setBalloonText: helpText; step ! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 14:36'! doAccept self delete! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 19:40'! doCancel thingsToRevert keysAndValuesDo: [ :k :v | myTarget perform: k with: v ]. self delete! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:24'! doEnables! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:23'! enable: aMorph when: aBoolean aBoolean = (aMorph hasProperty: #disabledMaskColor) ifFalse: [^self]. aBoolean ifTrue: [ aMorph removeProperty: #disabledMaskColor; lock: false; changed. ^self ]. aMorph setProperty: #disabledMaskColor toValue: (Color black alpha: 0.5); lock: true; changed ! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:22'! inAColumn: aCollectionOfMorphs | col | col _ AlignmentMorphBob1 newColumn color: Color transparent; vResizing: #shrinkWrap; layoutInset: 1; wrapCentering: #center; cellPositioning: #topCenter. aCollectionOfMorphs do: [ :each | col addMorphBack: each]. ^col! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:22'! inAColumn: anArray named: aString ^(self inAColumn: anArray) setNamePropertyTo: aString! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:22'! inARow: anArray named: aString ^(self inARow: anArray) setNamePropertyTo: aString! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 14:37'! lockedString: s ^(StringMorph contents: s) lock. ! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:22'! mouseAdjust: evt in: aMorph | fractionalPosition feedBack | feedBack _ self showSliderFeedback: nil. feedBack world ifNil: [ feedBack bottomLeft: evt cursorPoint - (0@8); openInWorld ]. fractionalPosition _ (evt cursorPoint - aMorph topLeft) / aMorph extent. self perform: (aMorph valueOfProperty: #changeSelector) with: fractionalPosition ! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:01'! openNearTarget | w wb tb leftOverlap rightOverlap topOverlap bottomOverlap best | w _ myTarget world ifNil: [World]. wb _ w bounds. self fullBounds. tb _ myTarget boundsInWorld. leftOverlap _ self width - (tb left - wb left). rightOverlap _ self width - (wb right - tb right). topOverlap _ self height - (tb top - wb top). bottomOverlap _ self height - (wb bottom - tb bottom). best _ nil. { {leftOverlap. #topRight:. #topLeft}. {rightOverlap. #topLeft:. #topRight}. {topOverlap. #bottomLeft:. #topLeft}. {bottomOverlap. #topLeft:. #bottomLeft}. } do: [ :tuple | (best isNil or: [tuple first < best first]) ifTrue: [best _ tuple]. ]. self perform: best second with: (tb perform: best third). self top: (self top max: wb top). self bottom: (self bottom min: wb bottom). self left: (self left max: wb left). self right: (self right min: wb right). self openInWorld: w.! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:21'! showSliderFeedback: aString | feedBack | feedBack _ self valueOfProperty: #sliderFeedback ifAbsent: [ feedBack _ AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; color: (Color yellow" alpha: 0.6"); addMorph: ( TextMorph new contents: '?'; beAllFont: ((TextStyle default fontOfSize: 24) emphasized: 1) ). self setProperty: #sliderFeedback toValue: feedBack. feedBack ]. aString ifNotNil: [feedBack firstSubmorph contents: aString asString]. ^feedBack! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:24'! step super step. self doEnables! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:24'! stepTime ^500! ! !GenericPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:01'! targetMorph: x myTarget _ x! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:45'! addTextToTarget | newText initial curr | initial _ '???'. (curr _ self targetProperties currentTextInButton) ifNotNil: [ initial _ curr contents ]. newText _ FillInTheBlank request: 'Text for this button' initialAnswer: initial. newText isEmptyOrNil ifTrue: [^self]. self targetProperties addTextToButton: newText. ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:47'! adjustTargetMouseDownHaloSize: aFractionalPoint | n | self targetProperties mouseDownHaloWidth: (n _ (aFractionalPoint x * 10) rounded max: 0). self showSliderFeedback: n.! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:48'! adjustTargetMouseOverHaloSize: aFractionalPoint | n | self targetProperties mouseOverHaloWidth: (n _ (aFractionalPoint x * 10) rounded max: 0). self showSliderFeedback: n.! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:18'! adjustTargetRepeatingInterval: aFractionalPoint | n s | n _ 2 raisedTo: ((aFractionalPoint x * 12) rounded max: 1). self targetProperties delayBetweenFirings: n. s _ n < 1000 ifTrue: [n printString,' ms'] ifFalse: [(n // 1000) printString,' secs']. self showSliderFeedback: s.! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:25'! doEnables | itsName | self allMorphsDo: [ :each | itsName _ each knownName. itsName == #pickerForMouseDownColor ifTrue: [ self enable: each when: self targetWantsRollover ]. itsName == #pickerForMouseOverColor ifTrue: [ self enable: each when: self targetWantsRollover ]. itsName == #paneForRepeatingInterval ifTrue: [ self enable: each when: self targetRepeatingWhileDown ]. ]. ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:05'! initialize super initialize. myTarget ifNil: [myTarget _ RectangleMorph new openInWorld]. self borderWidth: 4. self layoutInset: 4. self hResizing: #shrinkWrap. self vResizing: #shrinkWrap. self color: (Color r: 0.935 g: 0.839 b: 0.452). self borderColor: self color darker. self useRoundedCorners. self rebuild. ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:48'! paneForActsOnMouseDownToggle ^self inARow: { self directToggleButtonFor: self getter: #targetActsOnMouseDown setter: #toggleTargetActsOnMouseDown help: 'If the button is to act when the mouse goes down'. self lockedString: ' Mouse-down action'. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:49'! paneForActsOnMouseUpToggle ^self inARow: { self directToggleButtonFor: self getter: #targetActsOnMouseUp setter: #toggleTargetActsOnMouseUp help: 'If the button is to act when the mouse goes up'. self lockedString: ' Mouse-up action'. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:33'! paneForMouseDownColorPicker ^self inAColumn: { (self inAColumn: { self colorPickerFor: self targetProperties getter: #mouseDownHaloColor setter: #mouseDownHaloColor:. self lockedString: 'mouse-down halo color'. self paneForMouseDownHaloWidth. } named: #pickerForMouseDownColor) layoutInset: 0. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:36'! paneForMouseDownHaloWidth ^(self inARow: { self buildFakeSlider: 'mouse-down halo width' selector: #adjustTargetMouseDownHaloSize: help: 'Drag in here to change the halo width' }) hResizing: #shrinkWrap ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:34'! paneForMouseOverColorPicker ^self inAColumn: { (self inAColumn: { self colorPickerFor: self targetProperties getter: #mouseOverHaloColor setter: #mouseOverHaloColor:. self lockedString: 'mouse-over halo color'. self paneForMouseOverHaloWidth. } named: #pickerForMouseOverColor) layoutInset: 0. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:36'! paneForMouseOverHaloWidth ^(self inARow: { self buildFakeSlider: 'mouse-over halo width' selector: #adjustTargetMouseOverHaloSize: help: 'Drag in here to change the halo width' }) hResizing: #shrinkWrap ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:23'! paneForRepeatingInterval ^(self inAColumn: { self buildFakeSlider: 'repeating interval' selector: #adjustTargetRepeatingInterval: help: 'Drag in here to change how often the button repeats while the mouse is down' } named: #paneForRepeatingInterval ) hResizing: #shrinkWrap ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 16:59'! paneForWantsFiringWhileDownToggle ^self inARow: { self directToggleButtonFor: self getter: #targetRepeatingWhileDown setter: #toggleTargetRepeatingWhileDown help: 'Turn repeating while mouse is held down on or off'. self lockedString: ' Mouse-down repeating'. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 14:26'! paneForWantsRolloverToggle ^self inARow: { self directToggleButtonFor: self getter: #targetWantsRollover setter: #toggleTargetWantsRollover help: 'Turn mouse-over highlighting on or off'. self lockedString: ' Mouse-over highlighting'. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 19:41'! rebuild thingsToRevert _ Dictionary new. thingsToRevert at: #buttonProperties: put: myTarget buttonProperties. myTarget ensuredButtonProperties. self removeAllMorphs. self addAColumn: { self lockedString: 'Button Properties for ',myTarget name. }. self addAColumn: { (self inAColumn: { self paneForWantsRolloverToggle. }) hResizing: #shrinkWrap. }. self addARow: { self paneForMouseOverColorPicker. self paneForMouseDownColorPicker. }. self addAColumn: { (self inARow: { self paneForActsOnMouseDownToggle. self paneForActsOnMouseUpToggle. }) hResizing: #shrinkWrap. }. self addAColumn: { (self inAColumn: { self paneForRepeatingInterval. self paneForWantsFiringWhileDownToggle. }) hResizing: #shrinkWrap. }. self addARow: { self buttonNamed: 'Add label' action: #addTextToTarget color: color lighter help: 'add some text to the button'. self buttonNamed: 'Remove label' action: #removeTextFromTarget color: color lighter help: 'remove text from the button'. }. "====" self addARow: { self buttonNamed: 'Accept' action: #doAccept color: color lighter help: 'keep changes made and close panel'. self buttonNamed: 'Cancel' action: #doCancel color: color lighter help: 'cancel changes made and close panel'. }. ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:36'! removeTextFromTarget self targetProperties addTextToButton: nil. ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:49'! targetActsOnMouseDown ^self targetProperties actWhen == #mouseDown! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:49'! targetActsOnMouseUp ^self targetProperties actWhen == #mouseUp! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:05'! targetProperties ^myTarget ensuredButtonProperties! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:01'! targetRepeatingWhileDown ^self targetProperties delayBetweenFirings notNil! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 14:28'! targetWantsRollover ^self targetProperties wantsRolloverIndicator! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:51'! toggleTargetActsOnMouseDown | prop | prop _ self targetProperties. prop actWhen: (prop actWhen == #mouseDown ifTrue: [nil] ifFalse: [#mouseDown])! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:50'! toggleTargetActsOnMouseUp | prop | prop _ self targetProperties. prop actWhen: (prop actWhen == #mouseUp ifTrue: [nil] ifFalse: [#mouseUp])! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 17:02'! toggleTargetRepeatingWhileDown | prop | prop _ self targetProperties. prop delayBetweenFirings: (prop delayBetweenFirings ifNil: [1024] ifNotNil: [nil]) ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 14:28'! toggleTargetWantsRollover self targetProperties wantsRolloverIndicator: self targetProperties wantsRolloverIndicator not! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:04'! adjustTargetBorderWidth: aFractionalPoint | n | myTarget borderWidth: (n _ (aFractionalPoint x * 10) rounded max: 0). self showSliderFeedback: n.! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:02'! adjustTargetGradientDirection: aFractionalPoint | fs p | (fs _ myTarget fillStyle) isGradientFill ifFalse: [^self]. fs direction: (p _ (aFractionalPoint * myTarget extent) rounded). self showSliderFeedback: p. myTarget changed. ! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:05'! adjustTargetGradientOrigin: aFractionalPoint | fs p | (fs _ myTarget fillStyle) isGradientFill ifFalse: [^self]. fs origin: (p _ myTarget topLeft + (aFractionalPoint * myTarget extent) rounded). self showSliderFeedback: p. myTarget changed. ! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:03'! adjustTargetShadowOffset: aFractionalPoint | n | myTarget changed; layoutChanged. myTarget shadowOffset: (n _ (aFractionalPoint * 4) rounded). self showSliderFeedback: n. myTarget changed; layoutChanged. ! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:03'! doEnables | itsName fs | fs _ myTarget fillStyle. self allMorphsDo: [ :each | itsName _ each knownName. itsName == #pickerForColor ifTrue: [ self enable: each when: fs isSolidFill | fs isGradientFill ]. itsName == #pickerForBorderColor ifTrue: [ self enable: each when: (myTarget respondsTo: #borderColor:) ]. itsName == #pickerForShadowColor ifTrue: [ self enable: each when: myTarget hasDropShadow ]. itsName == #pickerFor2ndGradientColor ifTrue: [ self enable: each when: fs isGradientFill ]. ]. ! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:04'! initialize super initialize. myTarget ifNil: [myTarget _ RectangleMorph new openInWorld]. self borderWidth: 4. self layoutInset: 4. self hResizing: #shrinkWrap. self vResizing: #shrinkWrap. self color: (Color r: 0.548 g: 0.839 b: 0.452). self borderColor: self color darker. self useRoundedCorners. self rebuild. ! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:03'! makeTargetGradientFill myTarget useGradientFill! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:02'! makeTargetSolidFill myTarget useSolidFill! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:04'! numberOneColor myTarget fillStyle isGradientFill ifFalse: [^myTarget color]. ^myTarget fillStyle colorRamp first value ! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:03'! numberOneColor: aColor myTarget fillStyle isGradientFill ifFalse: [ ^(myTarget isKindOf: SystemWindow) ifTrue: [ myTarget setWindowColor: aColor ] ifFalse: [ myTarget fillStyle: aColor ] ]. myTarget fillStyle firstColor: aColor forMorph: myTarget hand: nil ! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 19:40'! rebuild self removeAllMorphs. self addARow: { self lockedString: 'Properties for ',myTarget name. }. self addARow: { self inAColumn: { self paneForCornerRoundingToggle. self paneForStickinessToggle. self paneForLockedToggle. }. }. self addARow: { self paneForMainColorPicker. self paneFor2ndGradientColorPicker. }. self addARow: { self paneForBorderColorPicker. self paneForShadowColorPicker. }. self addARow: { self buttonNamed: 'Accept' action: #doAccept color: color lighter help: 'keep changes made and close panel'. self buttonNamed: 'Cancel' action: #doCancel color: color lighter help: 'cancel changes made and close panel'. }. thingsToRevert _ Dictionary new. "thingsToRevert at: #fillStyle: put: myTarget fillStyle." (myTarget isKindOf: SystemWindow) ifTrue: [ thingsToRevert at: #setWindowColor: put: myTarget paneColorToUse ]. thingsToRevert at: #hasDropShadow: put: myTarget hasDropShadow. thingsToRevert at: #shadowColor: put: myTarget shadowColor. (myTarget respondsTo: #borderColor:) ifTrue: [ thingsToRevert at: #borderColor: put: myTarget borderColor. ]. thingsToRevert at: #borderWidth: put: myTarget borderWidth. thingsToRevert at: #cornerStyle: put: myTarget cornerStyle. thingsToRevert at: #cornerStyle: put: myTarget cornerStyle. thingsToRevert at: #sticky: put: myTarget isSticky. thingsToRevert at: #lock: put: myTarget isLocked. ! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:03'! targerBorderIsInset (myTarget respondsTo: #borderColor) ifFalse: [^false]. ^myTarget borderColor == #inset! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:03'! targerBorderIsRaised (myTarget respondsTo: #borderColor) ifFalse: [^false]. ^myTarget borderColor == #raised! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:04'! targetBorderColor (myTarget respondsTo: #borderColor) ifFalse: [^Color black]. ^myTarget borderColor! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:02'! targetBorderColor: aColor (myTarget respondsTo: #borderColor:) ifFalse: [^self]. myTarget borderColor: aColor! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:04'! targetHasGradientFill ^myTarget fillStyle isGradientFill! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:01'! targetHasSolidFill ^myTarget fillStyle isSolidFill! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:03'! targetRadial myTarget fillStyle isGradientFill ifFalse: [^false]. ^myTarget fillStyle radial! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:03'! tgt2ndGradientColor myTarget fillStyle isGradientFill ifFalse: [^Color black]. ^myTarget fillStyle colorRamp last value! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:03'! tgt2ndGradientColor: aColor myTarget fillStyle lastColor: aColor forMorph: myTarget hand: nil ! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:02'! toggleTargetBorderInset (myTarget respondsTo: #borderColor:) ifFalse: [^self]. myTarget borderColor: ( myTarget borderColor == #inset ifTrue: [Color black] ifFalse: [#inset] )! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:02'! toggleTargetBorderRaised (myTarget respondsTo: #borderColor:) ifFalse: [^self]. myTarget borderColor: ( myTarget borderColor == #raised ifTrue: [Color black] ifFalse: [#raised] )! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/8/2001 18:02'! toggleTargetRadial | fs | (fs _ myTarget fillStyle) isGradientFill ifFalse: [^self]. fs radial: fs radial not. myTarget changed. self doEnables.! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'RAA 3/8/2001 18:04'! paneForCornerRoundingToggle ^self inARow: { self directToggleButtonFor: myTarget getter: #wantsRoundedCorners setter: #toggleCornerRounding help: 'Turn rounded corners on or off'. self lockedString: ' Rounded corners'. } ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'RAA 3/8/2001 18:01'! paneForDropShadowToggle ^self inARow: { self directToggleButtonFor: myTarget getter: #hasDropShadow setter: #toggleDropShadow help: 'Turn drop shadows on or off'. self lockedString: ' Drop shadow color'. } ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'RAA 3/8/2001 18:04'! paneForLockedToggle ^self inARow: { self directToggleButtonFor: myTarget getter: #isLocked setter: #toggleLocked help: 'Turn lock on or off'. self lockedString: ' Lock'. } ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'RAA 3/8/2001 18:03'! paneForShadowColorPicker ^self inAColumn: { (self inAColumn: { self colorPickerFor: myTarget getter: #shadowColor setter: #shadowColor:. self paneForShadowOffset. } named: #pickerForShadowColor) layoutInset: 0. self paneForDropShadowToggle hResizing: #shrinkWrap. } ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'RAA 3/8/2001 18:04'! paneForStickinessToggle ^self inARow: { self directToggleButtonFor: myTarget getter: #isSticky setter: #toggleStickiness help: 'Turn stickiness on or off'. self lockedString: ' Sticky'. } ! ! ObjectPropertiesMorph removeSelector: #addARow:! ObjectPropertiesMorph removeSelector: #buildFakeSlider:selector:help:! ObjectPropertiesMorph removeSelector: #buttonNamed:action:color:help:! ObjectPropertiesMorph removeSelector: #colorPickerFor:getter:setter:! ObjectPropertiesMorph removeSelector: #directToggleButtonFor:getter:setter:help:! ObjectPropertiesMorph removeSelector: #doAccept! ObjectPropertiesMorph removeSelector: #doCancel! ObjectPropertiesMorph removeSelector: #enable:when:! ObjectPropertiesMorph removeSelector: #inAColumn:! ObjectPropertiesMorph removeSelector: #inAColumn:named:! ObjectPropertiesMorph removeSelector: #inARow:named:! ObjectPropertiesMorph removeSelector: #lockedString:! ObjectPropertiesMorph removeSelector: #mouseAdjust:in:! ObjectPropertiesMorph removeSelector: #openNearTarget! ObjectPropertiesMorph removeSelector: #step! ObjectPropertiesMorph removeSelector: #stepTime! ObjectPropertiesMorph removeSelector: #targetMorph:! GenericPropertiesMorph subclass: #ObjectPropertiesMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Experimental'!