'From Squeak5.3alpha of 21 May 2019 [latest update: #18589] on 28 May 2019 at 6:16:35 pm'! CharacterScanner subclass: #CharacterBlockScanner instanceVariableNames: 'characterPoint characterIndex nextLeftMargin specialWidth lastCharacterWidth ' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Text'! !CharacterBlockScanner commentStamp: 'pre 5/27/2019 17:56' prior: 0! A CharacterScanner does scan text to compute the CharacterBlock for a character specified by its index in the text or its proximity to the cursor location. The CharacterBlock stores information both about character layout and character index in the text. This class is essential for selecting text with the mouse or with arrow keys. Instance Variables characterIndex: characterPoint: lastCharacterWidth: nextLeftMargin: characterIndex - the index of character for which the layout information is searched, or nil when the layout is searched by cursor location characterPoint - the cursor location for which nearest character index and layout are searched. lastCharacterWidth - a number indicating the width of last character being processed. Note that this variable is left to nil during the inner scan loop, and only set on stopConditions. nextLeftMargin - a number specifying the distance between left of composition zone and left of first character for the next line. ! !Character class methodsFor: 'accessing untypeable characters' stamp: 'pre 5/28/2019 18:16'! startOfHeader ^ self value: 1 ! ! !CharacterScanner methodsFor: 'private-text-anchor' stamp: 'pre 5/24/2019 15:46'! missingTextAnchorAttribute ^ TextAnchor new anchoredMorph: self startOfHeadingIcon; yourself! ! !CharacterScanner methodsFor: 'private-text-anchor' stamp: 'pre 5/24/2019 15:46'! startOfHeadingIcon ^ ToolIcons no! ! !CharacterScanner methodsFor: 'private' stamp: 'pre 5/27/2019 17:53'! placeEmbeddedObjectFrom: aTextAttribute "Place the anchoredMorph or return false if it cannot be placed" ^ true! ! !CharacterScanner methodsFor: 'stop conditions' stamp: 'pre 5/24/2019 15:47'! embeddedObject pendingKernX := 0. ((text attributesAt: lastIndex) reject: [:each | each anchoredMorph isNil]) ifEmpty: [self placeEmbeddedObjectFrom: self missingAttribute] ifNotEmpty: [:attributes | attributes do: [:attr | "Try to placeEmbeddedObject: - if it answers false, then there's no place left" (self placeEmbeddedObjectFrom: attr) ifFalse: [^self crossedX]]]. "Note: if ever several objects are embedded on same character, only indent lastIndex once" lastIndex := lastIndex + 1. ^false! ! !CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'pre 5/27/2019 17:51'! setFont super setFont! ! !CharacterBlockScanner methodsFor: 'private' stamp: 'pre 5/27/2019 17:51'! placeEmbeddedObjectFrom: aTextAttribute | anchoredMorph width | anchoredMorph := aTextAttribute anchoredMorph. anchoredMorph textAnchorType = #paragraph ifTrue: [^ true]. width := anchoredMorph textAnchorConsumesHorizontalSpace ifTrue: [anchoredMorph width + anchoredMorph textAnchorHorizontalPadding] ifFalse: [0]. lastCharacterWidth := width. (destX + width > characterPoint x) ifTrue: [^false]. destX := destX + width + kern. ^ true! ! !CharacterBlockScanner methodsFor: 'private' stamp: 'pre 5/27/2019 17:50'! retrieveLastCharacterWidth | lastCharacter | lastIndex > text size ifTrue: [^lastCharacterWidth := 0]. lastCharacter := text at: lastIndex. (lastCharacter charCode >= 256 or: [(stopConditions at: lastCharacter charCode + 1) isNil]) ifTrue: [lastCharacterWidth := font widthOf: (text at: lastIndex)]. "if last character was a stop condition, then the width is already set" ^lastCharacterWidth! ! !CompositionScanner methodsFor: 'private' stamp: 'pre 5/28/2019 17:41'! alignmentMorphOffsetFor: aMorph ^ aMorph textAnchorVerticalAlignment first caseOf: { [#top] -> [0]. [#middle] -> [aMorph height / 2]. [#bottom] -> [aMorph height]}! ! !CompositionScanner methodsFor: 'private' stamp: 'pre 5/28/2019 17:42'! baselineAdjustmentForMorph: aMorph ^ aMorph textAnchorVerticalAlignment second caseOf: { [#top] -> [font ascent]. [#middle] -> [font ascent / 2]. [#baseline] -> [0]. [#bottom] -> [font descent negated]}. ! ! !CompositionScanner methodsFor: 'private' stamp: 'pre 5/28/2019 17:46'! lineHeightForMorph: aMorph | adjustedLineHeight morphHeight total | morphHeight := aMorph height + aMorph textAnchorVerticalPadding. total := lineHeight + morphHeight. adjustedLineHeight := 0. ^ lineHeight max: adjustedLineHeight ! ! !CompositionScanner methodsFor: 'private' stamp: 'pre 5/28/2019 18:07'! lineHeightForMorphOfHeight: aMorphHeight aligned: morphPosition to: linePosition paddedWith: verticalPadding | adjustedLineHeight morphHeight total | morphHeight := aMorphHeight + verticalPadding. total := font height + morphHeight. adjustedLineHeight := 0. morphPosition = #top ifTrue: [ linePosition = #top ifTrue: [adjustedLineHeight := total - font height]. linePosition = #middle ifTrue: [adjustedLineHeight := total - (font descent + (font ascent / 2))]. linePosition = #baseline ifTrue: [adjustedLineHeight := total - font descent]. linePosition = #bottom ifTrue: [adjustedLineHeight := total].]. morphPosition = #middle ifTrue: [ | upperMorphHalf lowerMorphHalf | upperMorphHalf := self lineHeightForMorphOfHeight: aMorphHeight / 2 aligned: #bottom to: linePosition paddedWith: verticalPadding / 2. lowerMorphHalf := self lineHeightForMorphOfHeight: aMorphHeight / 2 aligned: #top to: linePosition paddedWith: verticalPadding / 2. adjustedLineHeight := upperMorphHalf + lowerMorphHalf - font height]. morphPosition = #bottom ifTrue: [ linePosition = #top ifTrue: [adjustedLineHeight := total]. linePosition = #middle ifTrue: [adjustedLineHeight := total - (font ascent / 2)]. linePosition = #baseline ifTrue: [adjustedLineHeight := total - font ascent]. linePosition = #bottom ifTrue: [adjustedLineHeight := total - font height].]. ^ lineHeight max: adjustedLineHeight ! ! !CompositionScanner methodsFor: 'private' stamp: 'pre 5/28/2019 18:08'! placeEmbeddedObjectFrom: aTextAttribute | anchoredMorph width | anchoredMorph := aTextAttribute anchoredMorph. anchoredMorph textAnchorType = #paragraph ifTrue: [^ true]. "If it is not anchored at the paragraph we assume that it is inline." width := anchoredMorph width + anchoredMorph textAnchorHorizontalPadding. (destX + width > rightMargin and: [(leftMargin + width) <= rightMargin or: [lastIndex > line first]]) ifTrue: ["Won't fit, but would on next line" ^ false]. "The width had to be set beforehand to account for line wrapping. Now it might not be necessary anymore. --pre" width := anchoredMorph textAnchorConsumesHorizontalSpace ifTrue: [anchoredMorph width + anchoredMorph textAnchorHorizontalPadding] ifFalse: [0]. destX := destX + width + kern. baseline := baseline max: (self alignmentMorphOffsetFor: anchoredMorph) + (self baselineAdjustmentForMorph: anchoredMorph). lineHeight := self lineHeightForMorphOfHeight: anchoredMorph height aligned: anchoredMorph textAnchorVerticalAlignment first to: anchoredMorph textAnchorVerticalAlignment second paddedWith: anchoredMorph textAnchorVerticalPadding. ^ true! ! !DisplayScanner methodsFor: 'stop conditions' stamp: 'pre 5/24/2019 16:10'! embeddedObject "TODO: document the reason for this decrement --pre" lastDisplayableIndex := lastIndex - 1. ^ super embeddedObject! ! !DisplayScanner methodsFor: 'private' stamp: 'pre 5/27/2019 18:00'! placeEmbeddedObjectFrom: aTextAttribute | anchoredMorphOrForm position width | anchoredMorphOrForm := aTextAttribute anchoredMorph. anchoredMorphOrForm relativeTextAnchorPosition ifNotNil: [^ self placeEmbeddedObjectRelative: anchoredMorphOrForm]. position := destX @ lineY. (anchoredMorphOrForm isMorph or: [anchoredMorphOrForm isPrimitiveCostume]) ifTrue: [ | alignedPositionY | alignedPositionY := self verticallyAlignEmbeddedMorph: anchoredMorphOrForm given: position. position := (position x + anchoredMorphOrForm textAnchorPadding left) @ alignedPositionY. anchoredMorphOrForm position: position - morphicOffset. width := anchoredMorphOrForm textAnchorConsumesHorizontalSpace ifTrue: [anchoredMorphOrForm width + anchoredMorphOrForm textAnchorHorizontalPadding] ifFalse: [0]] ifFalse: [ self displayEmbeddedForm: anchoredMorphOrForm at: position. width := anchoredMorphOrForm width.]. destX := destX + width + kern. ^ true! ! !DisplayScanner methodsFor: 'private' stamp: 'pre 5/24/2019 16:06'! placeEmbeddedObjectRelative: anchoredMorphOrForm anchoredMorphOrForm position: anchoredMorphOrForm relativeTextAnchorPosition + (anchoredMorphOrForm owner textBounds origin x @ (lineY - morphicOffset y)). ^ true! ! !DisplayScanner methodsFor: 'private' stamp: 'pre 5/28/2019 17:31'! verticallyAlignEmbeddedMorph: aMorph given: position | alignedPositionY positionInLine morphPosition | alignedPositionY := position y + line baseline. positionInLine := aMorph textAnchorVerticalAlignment second. positionInLine = #top ifTrue: [alignedPositionY := alignedPositionY - font ascent]. positionInLine = #middle ifTrue: [alignedPositionY := (alignedPositionY - (font ascent / 2)) floor]. positionInLine = #bottom ifTrue: [alignedPositionY := alignedPositionY + font descent]. "#baseline does not require adjustments" morphPosition := aMorph textAnchorVerticalAlignment first. morphPosition = #middle ifTrue: [alignedPositionY := (alignedPositionY - (aMorph height / 2)) floor]. morphPosition = #bottom ifTrue: [alignedPositionY := alignedPositionY - aMorph height]. "#top does not require adjustments" ^ alignedPositionY! ! !DisplayScanner methodsFor: 'displaying' stamp: 'pre 5/24/2019 16:03'! displayEmbeddedForm: aForm at: aPoint self subclassResponsibility! ! !BitBltDisplayScanner methodsFor: 'displaying' stamp: 'pre 5/24/2019 16:03'! displayEmbeddedForm: aForm at: aPoint aForm displayOn: bitBlt destForm at: aPoint clippingBox: bitBlt clipRect rule: Form blend fillColor: Color white ! ! !Morph methodsFor: 'text-anchor-menu' stamp: 'pre 5/23/2019 17:27'! changeDocumentAnchor "Change the anchor from/to document anchoring" | newType | newType := self textAnchorType == #document ifTrue: [#paragraph] ifFalse: [ #document]. owner isTextMorph ifTrue: [ owner anchorMorph: self at: self position type: newType]! ! !Morph methodsFor: 'text-anchor' stamp: 'pre 5/24/2019 16:26'! relativeTextAnchorPosition ^ self valueOfProperty: #relativeTextAnchorPosition! ! !Morph methodsFor: 'text-anchor' stamp: 'pre 5/24/2019 15:42'! textAnchorConsumesHorizontalSpace ^ self valueOfProperty: #textAnchorConsumesHorizontalSpace ifAbsent: [true]! ! !Morph methodsFor: 'text-anchor' stamp: 'pre 5/24/2019 15:41'! textAnchorConsumesHorizontalSpace: aBoolean ^ self setProperty: #textAnchorConsumesHorizontalSpace toValue: aBoolean! ! !Morph methodsFor: 'text-anchor' stamp: 'pre 5/24/2019 15:39'! textAnchorDefaultAlignment ^ #(bottom baseline)! ! !Morph methodsFor: 'text-anchor' stamp: 'pre 5/24/2019 15:58'! textAnchorHorizontalPadding | padding | padding := self textAnchorPadding. ^ padding left + padding right! ! !Morph methodsFor: 'text-anchor' stamp: 'pre 5/24/2019 15:55'! textAnchorPadding ^ self valueOfProperty: #textAnchorPadding ifAbsent: [0@0 corner: 0@0]! ! !Morph methodsFor: 'text-anchor' stamp: 'pre 5/24/2019 16:18'! textAnchorPadding: numberOrPointOrRectangle | padding | padding := numberOrPointOrRectangle. padding isPoint ifTrue: [ padding := padding corner: padding]. padding isNumber ifTrue: [ padding := padding@padding corner: padding@padding]. ^ self setProperty: #textAnchorPadding toValue: padding! ! !Morph methodsFor: 'text-anchor' stamp: 'pre 5/24/2019 15:42'! textAnchorType ^ self valueOfProperty: #textAnchorType ifAbsent: [#document]! ! !Morph methodsFor: 'text-anchor' stamp: 'pre 5/24/2019 16:28'! textAnchorVerticalAlignment ^ self valueOfProperty: #textAnchorVerticalAlignment ifAbsent: [self textAnchorDefaultAlignment]! ! !Morph methodsFor: 'text-anchor' stamp: 'pre 5/24/2019 16:28'! textAnchorVerticalAlignment: tupleOfMorphPartAndTextlinePart "This method accepts tuples in which the first element designates which part of the morph is aligned to which part of the text line which the second element designates. Morph part: top, bottom, middle Text line position: top, middle, baseline, bottom" self assert: (#(top, bottom, middle) includes: tupleOfMorphPartAndTextlinePart first). self assert: (#(top, middle, baseline, bottom) includes: tupleOfMorphPartAndTextlinePart second). ^ self setProperty: #textAnchorVerticalAlignment toValue: tupleOfMorphPartAndTextlinePart! ! !Morph methodsFor: 'text-anchor' stamp: 'pre 5/24/2019 16:01'! textAnchorVerticalPadding | padding | padding := self textAnchorPadding. ^ padding top + padding bottom! ! !TextAnchorTest methodsFor: 'running' stamp: 'pre 5/23/2019 17:29'! setUp super setUp. prototypes add: (TextAnchor new anchoredMorph: RectangleMorph new initialize); add: (TextAnchor new anchoredMorph: EllipseMorph new initialize) ! ! !TextAnchorTest methodsFor: 'tests' stamp: 'pre 5/23/2019 17:29'! testBeginWithAnAnchor | text morph model anchoredMorph | anchoredMorph := Morph new. text := Text streamContents: [:stream | stream nextPutAll: (Text string: Character startOfHeader asString attributes: {TextAnchor new anchoredMorph: anchoredMorph. TextColor color: Color transparent}) ; nextPutAll: ' should be able to begin with an embedded object. ']. model := text -> nil. morph := PluggableTextMorph on: model text: #key accept: nil. [ morph openInWorld. self assert: (anchoredMorph ownerChain includes: morph)] ensure: [ morph delete ]! ! !TextAnchorTest methodsFor: 'tests' stamp: 'pre 5/28/2019 18:10'! testHavingAnAnchorCanBeAlignedDifferently | text morph model anchoredMorph | anchoredMorph := Morph new. anchoredMorph textAnchorVerticalAlignment: #(top baseline). anchoredMorph textAnchorConsumesHorizontalSpace: true. anchoredMorph textAnchorPadding: 2. text := Text streamContents: [ :stream | stream nextPutAll: 'Here is an example '; nextPutAll: (Text string: Character startOfHeader asString attributes: {TextAnchor new anchoredMorph: anchoredMorph. TextColor color: Color transparent}); nextPutAll: 'whose morph is in the middle. ' ]. model := text -> nil. morph := PluggableTextMorph on: model text: #key accept: nil. [ morph openInWorld. self assert: (anchoredMorph ownerChain includes: morph)] ensure: [ "morph delete" ]! ! !TextAnchorTest methodsFor: 'tests' stamp: 'pre 5/24/2019 15:40'! testHavingAnAnchorInTheMiddle | text morph model anchoredMorph | anchoredMorph := Morph new. text := Text streamContents: [ :stream | stream nextPutAll: 'Here is an example '; nextPutAll: (Text string: Character startOfHeader asString attributes: {TextAnchor new anchoredMorph: anchoredMorph. TextColor color: Color transparent}); nextPutAll: ' whose morph is in the middle. ' ]. model := text -> nil. morph := PluggableTextMorph on: model text: #key accept: nil. [ morph openInWorld. self assert: (anchoredMorph ownerChain includes: morph)] ensure: [ morph delete ]! ! !TextAnchorTest methodsFor: 'tests' stamp: 'pre 5/23/2019 18:00'! testHavingAnAnchorInTheMiddleAndRelativeTextAnchorPosition | text morph model anchoredMorph | anchoredMorph := Morph new. anchoredMorph relativeTextAnchorPosition: 20@10. text := Text streamContents: [ :stream | stream nextPutAll: 'Here is an example '; nextPutAll: (Text string: Character startOfHeader asString attributes: {TextAnchor new anchoredMorph: anchoredMorph. TextColor color: Color transparent}); nextPutAll: ' whose morph is in the middle. ' ]. model := text -> nil. morph := PluggableTextMorph on: model text: #key accept: nil. [ morph openInWorld. self assert: (anchoredMorph ownerChain includes: morph)] ensure: [ morph delete ]! ! !TextAnchorTest methodsFor: 'tests' stamp: 'pre 5/24/2019 16:29'! testHavingAnAnchorInTheMiddleWithHorizontalPadding | text morph model anchoredMorph | anchoredMorph := Morph new. anchoredMorph textAnchorPadding: 30@0. text := Text streamContents: [ :stream | stream nextPutAll: 'Here is an example '; nextPutAll: (Text string: Character startOfHeader asString attributes: {TextAnchor new anchoredMorph: anchoredMorph. TextColor color: Color transparent}); nextPutAll: ' whose morph is in the middle. ' ]. model := text -> nil. morph := PluggableTextMorph on: model text: #key accept: nil. [ morph openInWorld. self assert: (anchoredMorph ownerChain includes: morph)] ensure: [ morph delete ]! ! !Morph reorganize! ('accessing' actorStateOrNil actorState: adoptPaneColor: balloonText balloonText: balloonTextSelector balloonTextSelector: beFlap: beSticky beTransparent beUnsticky borderColor borderColor: borderStyle borderStyleForSymbol: borderStyle: borderWidth borderWidthForRounding borderWidth: clearArea color colorForInsets color: couldHaveRoundedCorners defaultNameStemForInstances eventHandler eventHandler: forwardDirection hasTranslucentColor highlight highlightColor highlightColor: insetColor isFlap isLocked isShared isSticky lock lock: methodCommentAsBalloonHelp modelOrNil player playerRepresented player: presenter raisedColor regularColor regularColor: rememberedColor rememberedColor: resistsRemoval resistsRemoval: scaleFactor setBorderStyle: sqkPage sticky: toggleLocked toggleResistsRemoval toggleStickiness unHighlight unlock unlockContents url userString viewBox visibleClearArea wantsToBeCachedByHand wantsToBeTopmost) ('accessing - extension' assureExtension extension hasExtension initializeExtension privateExtension: resetExtension) ('accessing - properties' hasProperty: otherProperties removeProperty: setProperties: setProperty:toValue: valueOfProperty: valueOfProperty:ifAbsentPut: valueOfProperty:ifAbsent: valueOfProperty:ifPresentDo:) ('caching' fullLoadCachedState fullReleaseCachedState loadCachedState releaseCachedState) ('change reporting' colorChangedForSubmorph: invalidRect: invalidRect:from: ownerChanged privateInvalidateMorph: userSelectedColor:) ('classification' demandsBoolean isAlignmentMorph isBalloonHelp isCompoundTileMorph isFlapOrTab isFlapTab isFlexMorph isHandMorph isKedamaMorph isModalShell isNumericReadoutTile isPhraseTileMorph isPlayfieldLike isRenderer isSoundTile isStandardViewer isStickySketchMorph isSyntaxMorph isTextMorph isTileMorph isTilePadMorph isViewer isWorldMorph isWorldOrHandMorph) ('connectors-scripting' wantsConnectorVocabulary) ('converting' asDraggableMorph asSnapshotThumbnail) ('copying' copy deepCopy duplicate duplicateMorphCollection: fullCopy updateReferencesUsing: usableSiblingInstance veryDeepCopyWith: veryDeepFixupWith: veryDeepInner:) ('creation' asMorph) ('debug and other' addDebuggingItemsTo:hand: addMouseActionIndicatorsWidth:color: addMouseUpAction addMouseUpActionWith: addViewingItemsTo: allStringsAfter: altSpecialCursor0 altSpecialCursor1 altSpecialCursor2 altSpecialCursor3 altSpecialCursor3: buildDebugMenu: defineTempCommand deleteAnyMouseActionIndicators inspectArgumentsPlayerInMorphic: inspectOwnerChain installModelIn: mouseUpCodeOrNil ownerChain programmedMouseDown:for: programmedMouseEnter:for: programmedMouseLeave:for: programmedMouseUp:for: removeMouseUpAction resumeAfterDrawError resumeAfterStepError tempCommand viewMorphDirectly) ('dispatching' disableSubmorphFocusForHand:) ('drawing' areasRemainingToFill: boundingBoxOfSubmorphs boundsWithinCorners changeClipSubmorphs clipLayoutCells clipLayoutCells: clippingBounds clipSubmorphs clipSubmorphs: doesOwnRotation drawDropHighlightOn: drawDropShadowOn: drawErrorOn: drawKeyboardFocusIndicationOn: drawMouseDownHighlightOn: drawOn: drawOverlayOn: drawRolloverBorderOn: drawSubmorphsOn: expandFullBoundsForDropShadow: expandFullBoundsForRolloverBorder: flashBounds fullDrawOn: hasClipSubmorphsString hide highlightedForMouseDown highlightForMouseDown highlightForMouseDown: imageForm imageFormDepth: imageFormForRectangle: imageFormWithout:andStopThere: imageForm:backgroundColor:forRectangle: imageForm:forRectangle: keyboardFocusColor keyboardFocusWidth refreshWorld shadowForm show updateDropShadowCache visible visible:) ('drop shadows' addDropShadow addDropShadowMenuItems:hand: changeShadowColor hasDropShadow hasDropShadowString hasDropShadow: hasRolloverBorder hasRolloverBorder: removeDropShadow setShadowOffset: shadowColor shadowColor: shadowOffset shadowOffset: shadowPoint: toggleDropShadow useSoftDropShadow useSoftDropShadow:) ('dropping/grabbing' aboutToBeGrabbedBy: acceptDroppingMorph:event: disableDragNDrop dragEnabled dragEnabled: dragNDropEnabled dragSelectionColor dropEnabled dropEnabled: dropHighlightColor dropSuccessColor enableDragNDrop enableDragNDrop: enableDrag: enableDrop: formerOwner formerOwner: formerPosition formerPosition: grabTransform handledOwnDraggingBy:on: highlightedForDrop highlightForDrop highlightForDrop: justDroppedInto:event: justGrabbedFrom: morphToDropInPasteUp: nameForUndoWording rejectDropMorphEvent: repelsMorph:event: resetHighlightForDrop separateDragAndDrop slideBackToFormerSituation: slideToTrash: startDrag:with: transportedMorph undoGrabCommand vanishAfterSlidingTo:event: wantsDroppedMorph:event: wantsToBeDroppedInto: wantsToBeOpenedInWorld willingToBeDiscarded) ('event handling' click click: cursorPoint doubleClickTimeout: doubleClick: dropFiles: firstClickTimedOut: handlerForMouseDown: handlerForYellowButtonDown: handlesKeyboard: handlesMouseDown: handlesMouseMove: handlesMouseOverDragging: handlesMouseOver: handlesMouseStillDown: handlesMouseWheel: hasFocus hasKeyboardFocus hasKeyboardFocus: hasMouseFocus hasMouseFocus: keyboardFocusChange: keyDown: keyStroke: keyUp: keyboardFocusDelegate mouseDown: mouseEnterDragging: mouseEnter: mouseLeaveDragging: mouseLeave: mouseMove: mouseStillDownThreshold mouseStillDown: mouseUp: mouseWheel: moveOrResizeFromKeystroke: on:send:to: on:send:to:withValue: preferredKeyboardBounds preferredKeyboardPosition removeLink: restoreSuspendedEventHandler startDrag: suspendEventHandler tabAmongFields transformFromOutermostWorld transformFromWorld transformFrom: wantsDropFiles: wantsEveryMouseMove wantsKeyboardFocus wantsKeyboardFocusFor: wantsWindowEvents: windowEvent: wouldAcceptKeyboardFocus wouldAcceptKeyboardFocusUponTab yellowButtonActivity:) ('events-accessing' actionMap updateableActionMap) ('events-alarms' addAlarm:after: addAlarm:at: addAlarm:withArguments:after: addAlarm:withArguments:at: addAlarm:with:after: addAlarm:with:at: addAlarm:with:with:after: addAlarm:with:with:at: alarmScheduler removeAlarm: removeAlarm:at:) ('events-processing' containsPoint:event: defaultEventDispatcher handleDropFiles: handleDropMorph: handleEvent: handleFocusEvent: handleKeyDown: handleKeyUp: handleKeystroke: handleListenEvent: handleMouseDown: handleMouseEnter: handleMouseLeave: handleMouseMove: handleMouseOver: handleMouseStillDown: handleMouseUp: handleMouseWheel: handleUnknownEvent: handleWindowEvent: mouseDownPriority mouseDownPriority: processEvent: processEvent:using: processFocusEvent: processFocusEvent:using: rejectDropEvent: rejectsEvent: sendFilterEvent:for:to: sendFilterEventBubble:for: sendFilterEventBubbleAgain:for: sendFilterEventCapture:for: sendFilterEventCaptureAgain:for: transformedFrom:) ('events-removing' releaseActionMap) ('fileIn/out' attachToResource reserveUrl: saveAsResource saveDocPane saveOnFile saveOnURL saveOnURLbasic saveOnURL: updateAllFromResources updateFromResource) ('filter streaming' drawOnCanvas:) ('geometry' align:with: bottom bottomCenter bottomLeft bottomLeft: bottomRight bottomRight: bottom: bounds boundsInWorld boundsIn: bounds: bounds:from: bounds:in: center center: extent fullBoundsInWorld globalPointToLocal: griddedPoint: gridPoint: height height: innerBounds intersects: left leftCenter left: localPointToGlobal: minimumExtent minimumExtent: minimumHeight minimumHeight: minimumWidth minimumWidth: outerBounds overlapsShadowForm:bounds: pointFromWorld: pointInWorld: point:from: point:in: position positionInWorld positionSubmorphs position: right rightCenter right: screenLocation screenRectangle setConstrainedPosition:hangOut: shiftSubmorphsOtherThan:by: top topCenter topLeft topLeft: topRight topRight: top: transformedBy: width width: worldBounds worldBoundsForHalo) ('geometry testing' containsPoint: fullContainsPoint: obtrudesBeyondContainer) ('halos and balloon help' addHalo addHalo:from: addHandlesTo:box: addMagicHaloFor: addOptionalHandlesTo:box: addSimpleHandlesTo:box: addWorldHandlesTo:box: balloonColor balloonColor: balloonFont balloonFont: balloonHelpAligner balloonHelpDelayTime balloonHelpTextForHandle: balloonMorphClass boundsForBalloon comeToFrontAndAddHalo createHalo defaultBalloonColor defaultBalloonFont defersHaloOnClickTo: deleteBalloon editBalloonHelpContent: editBalloonHelpText halo haloClass haloDelayTime hasHalo hasHalo: isLikelyRecipientForMouseOverHalos mouseDownOnHelpHandle: noHelpString okayToAddDismissHandle okayToAddGrabHandle okayToBrownDragEasily okayToExtractEasily okayToResizeEasily okayToRotateEasily preferredDuplicationHandleSelector removeHalo setBalloonText: setBalloonText:maxLineLength: setCenteredBalloonText: showBalloon showBalloon: showBalloon:at: showBalloon:hand: transferHalo:from: wantsBalloon wantsDirectionHandles wantsDirectionHandles: wantsHalo wantsHaloFor: wantsHaloFromClick wantsHaloFromClick: wantsHaloHandleWithSelector:inHalo: wantsScriptorHaloHandle wantsSimpleSketchMorphHandles) ('initialization' basicInitialize defaultBounds defaultColor inAScrollPane inATwoWayScrollPane initialize intoWorld: openCenteredInWorld openInWindow openInWindowLabeled: openInWindowLabeled:inWorld: openInWorld openNear: openNear:in: openNearMorph: outOfWorld: resourceJustLoaded standardPalette) ('layout' adjustLayoutBounds doLayoutIn: fullBounds layoutBounds layoutBounds: layoutChanged layoutInBounds: layoutProportionallyIn: minExtent minExtent: minHeight minHeight: minWidth minWidth: privateFullBounds submorphBounds) ('layout-menu' addCellLayoutMenuItems:hand: addLayoutMenuItems:hand: addTableLayoutMenuItems:hand: changeCellInset: changeClipLayoutCells changeDisableTableLayout changeLayoutInset: changeListDirection: changeMaxCellSize: changeMinCellSize: changeNoLayout changeProportionalLayout changeReverseCells changeRubberBandCells changeTableLayout hasClipLayoutCellsString hasDisableTableLayoutString hasNoLayoutString hasProportionalLayoutString hasReverseCellsString hasRubberBandCellsString hasTableLayoutString layoutMenuPropertyString:from:) ('layout-properties' assureLayoutProperties assureTableProperties cellInset cellInset: cellPositioning cellPositioningString: cellPositioning: cellSpacing cellSpacingString: cellSpacing: copyLayoutProperties disableTableLayout disableTableLayout: hResizing hResizingString: hResizing: layoutFrame layoutFrame: layoutInset layoutInset: layoutPolicy layoutPolicy: layoutProperties layoutProperties: listCentering listCenteringString: listCentering: listDirection listDirectionString: listDirection: listSpacing listSpacingString: listSpacing: maxCellSize maxCellSize: minCellSize minCellSize: reverseTableCells reverseTableCells: rubberBandCells rubberBandCells: spaceFillWeight spaceFillWeight: vResizeToFit: vResizing vResizingString: vResizing: wrapCentering wrapCenteringString: wrapCentering: wrapDirection wrapDirectionString: wrapDirection:) ('macpal' flash) ('menu' addBorderStyleMenuItems:hand: addGestureMenuItems:hand: addGraphModelYellowButtonItemsTo:event: addModelYellowButtonItemsTo:event: addMyYellowButtonMenuItemsToSubmorphMenus addNestedYellowButtonItemsTo:event: addTitleForHaloMenu: addYellowButtonMenuItemsTo:event: buildYellowButtonMenu: hasYellowButtonMenu offerCostumeViewerMenu: outermostOwnerWithYellowButtonMenu startWiring wantsMetaMenu wantsMetaMenu: wantsYellowButtonMenu wantsYellowButtonMenu:) ('menus' absorbStateFromRenderer: addAddHandMenuItemsForHalo:hand: addCopyItemsTo: addCustomHaloMenuItems:hand: addCustomMenuItems:hand: addExportMenuItems:hand: addFillStyleMenuItems:hand: addHaloActionsTo: addMiscExtrasTo: addPaintingItemsTo:hand: addStandardHaloMenuItemsTo:hand: addToggleItemsToHaloMenu: addWorldTargetSightingItems:hand: adhereToEdge adhereToEdge: adjustedCenter adjustedCenter: allMenuWordings changeColor changeDirectionHandles changeDrag changeDragAndDrop changeDrop chooseNewGraphic chooseNewGraphicCoexisting: chooseNewGraphicFromHalo collapse defaultArrowheadSize doMenuItem: exploreInMorphic exploreInMorphic: exportAsBMP exportAsBMPNamed: exportAsGIF exportAsGIFNamed: exportAsJPEG exportAsJPEGNamed: exportAsPNG exportAsPNGNamed: hasDirectionHandlesString hasDragAndDropEnabledString hasDragEnabledString hasDropEnabledString helpButton inspectInMorphic inspectInMorphic: lockedString lockUnlockMorph makeNascentScript maybeAddCollapseItemTo: menuItemAfter: menuItemBefore: model presentHelp reasonableBitmapFillForms reasonableForms resetForwardDirection resistsRemovalString setArrowheads setRotationCenter setRotationCenterFrom: setToAdhereToEdge: snapToEdgeIfAppropriate stickinessString transferStateToRenderer: uncollapseSketch) ('meta-actions' addEmbeddingMenuItemsTo:hand: applyStatusToAllSiblings: beThisWorldsModel bringAllSiblingsToMe: buildHandleMenu: buildMetaMenu: changeColorTarget:selector:originalColor:hand: copyToPasteBuffer: dismissMorph dismissMorph: duplicateMorphImage: duplicateMorph: embedInto: grabMorph: indicateAllSiblings inspectAt:event: invokeHaloOrMove: invokeMetaMenuAt:event: invokeMetaMenu: makeMultipleSiblings: makeNewPlayerInstance: makeSiblingsLookLikeMe: makeSiblings: maybeDuplicateMorph maybeDuplicateMorph: openAPropertySheet openATextPropertySheet potentialEmbeddingTargets potentialTargets potentialTargetsAt: resizeFromMenu resizeMorph: saveAsPrototype showActions showHiders sightTargets: sightWorldTargets: subclassMorph targetFromMenu: targetWith:) ('miscellaneous' roundUpStrays setExtentFromHalo: setFlexExtentFromHalo:) ('naming' downshiftedNameOfObjectRepresented innocuousName nameForFindWindowFeature nameInModel nameOfObjectRepresented name: setNamePropertyTo: setNameTo: specialNameInModel tryToRenameTo: updateAllScriptingElements) ('objects from disk' objectForDataStream: storeDataOn:) ('other events' menuButtonMouseEnter: menuButtonMouseLeave:) ('parts bin' initializeToStandAlone inPartsBin isPartsBin isPartsDonor isPartsDonor: markAsPartsDonor partRepresented residesInPartsBin) ('printing' clipText colorString: constructorString fullPrintOn: initString morphReport morphReportFor: morphReportFor:on:indent: pagesHandledAutomatically printConstructorOn:indent: printConstructorOn:indent:nodeDict: printOn: printSpecs printSpecs: printStructureOn:indent: reportableSize structureString textToPaste) ('*FlatWorld-Core' isFlatWorldPlayer) ('rotate scale and flex' addFlexShell addFlexShellIfNecessary keepsTransform newTransformationMorph referencePosition referencePosition: referencePositionInWorld referencePositionInWorld: removeFlexShell rotationCenter rotationCenter: rotationDegrees) ('rounding' cornerRadius cornerRadius: cornerStyle cornerStyle: roundedCorners roundedCornersString toggleCornerRounding wantsRoundedCorners) ('stepping and presenter' arrangeToStartStepping arrangeToStartSteppingIn: isStepping isSteppingSelector: start startStepping startSteppingIn: startSteppingSelector: startStepping:at:arguments:stepTime: step stepAt: stepTime stop stopStepping stopSteppingSelector: stopSteppingSelfAndSubmorphs wantsSteps) ('structure' activeHand allOwners allOwnersDo: containingWindow firstOwnerSuchThat: hasOwner: isInDockingBar isInSystemWindow isInWorld morphPreceding: nearestOwnerThat: orOwnerSuchThat: outermostMorphThat: outermostWorldMorph owner ownerThatIsA: ownerThatIsA:orA: pasteUpMorph pasteUpMorphHandlingTabAmongFields primaryHand renderedMorph root rootAt: topPasteUp topRendererOrSelf withAllOwners withAllOwnersDo: world) ('submorphs-accessing' allKnownNames allMorphs allMorphsDo: allNonSubmorphMorphs allSubmorphNamesDo: dockingBars findA: findDeeplyA: findDeepSubmorphThat:ifAbsent: findSubmorphBinary: firstSubmorph hasSubmorphs hasSubmorphWithProperty: indexOfMorphAbove: lastSubmorph mainDockingBars morphsAt: morphsAt:behind:unlocked: morphsAt:unlocked: morphsAt:unlocked:do: morphsInFrontOf:overlapping:do: morphsInFrontOverlapping: morphsInFrontOverlapping:do: noteNewOwner: rootMorphsAtGlobal: rootMorphsAt: shuffleSubmorphs submorphAfter submorphBefore submorphCount submorphNamed: submorphNamed:ifNone: submorphOfClass: submorphs submorphsBehind:do: submorphsDo: submorphsInFrontOf:do: submorphsReverseDo: submorphsSatisfying: submorphThat:ifNone: submorphWithProperty:) ('submorphs-add/remove' abandon actWhen actWhen: addAllMorphs: addAllMorphs:after: addAllMorphs:behind: addAllMorphs:inFrontOf: addAllMorphsBack: addAllMorphsFront: addMorphBack: addMorphCentered: addMorphFrontFromWorldPosition: addMorphFront: addMorphFront:fromWorldPosition: addMorphNearBack: addMorph: addMorph:after: addMorph:asElementNumber: addMorph:behind: addMorph:fullFrame: addMorph:inFrontOf: allMorphsWithPlayersDo: comeToFront copyWithoutSubmorph: delete deleteDockingBars deleteSubmorphsWithProperty: deleteUnlessHasFocus dismissViaHalo goBehind privateDelete removeAllMorphs removeAllMorphsIn: removedMorph: removeMorph: replaceSubmorph:by: submorphIndexOf:) ('testing' canDrawAtHigherResolution canDrawBorder: completeModificationHash couldMakeSibling indicateKeyboardFocus isDockingBar isFlexed isFullOnScreen isImageMorph isLineMorph isMenuItemMorph isMorph isSafeToServe isSelectionMorph isSketchMorph knownName modificationHash renameInternal: renameTo: shouldDropOnMouseUp) ('text-anchor-menu' addTextAnchorMenuItems:hand: changeDocumentAnchor changeInlineAnchor changeParagraphAnchor hasDocumentAnchorString hasInlineAnchorString hasParagraphAnchorString) ('text-anchor' relativeTextAnchorPosition relativeTextAnchorPosition: textAnchorConsumesHorizontalSpace textAnchorConsumesHorizontalSpace: textAnchorDefaultAlignment textAnchorHorizontalPadding textAnchorPadding textAnchorPadding: textAnchorType textAnchorType: textAnchorVerticalAlignment textAnchorVerticalAlignment: textAnchorVerticalPadding) ('thumbnail' demandsThumbnailing icon iconOrThumbnail iconOrThumbnailOfSize: morphRepresented permitsThumbnailing readoutForField: representativeNoTallerThan:norWiderThan:thumbnailHeight: thumbnail updateThumbnailUrl updateThumbnailUrlInBook:) ('undo' commandHistory undoMove:redo:owner:bounds:predecessor:) ('updating' applyUserInterfaceTheme changed) ('user interface' defaultLabelForInspector doCancel initialExtent) ('viewer' externalName) ('visual properties' canApplyUserInterfaceTheme canHaveFillStyles defaultBitmapFillForm fillStyle fillStyle: fillWithRamp:oriented: useBitmapFill useDefaultFill useGradientFill useSolidFill) ('WiW support' addMorphInFrontOfLayer: addMorphInLayer: eToyRejectDropMorph:event: morphicLayerNumber morphicLayerNumberWithin: randomBoundsFor: shouldGetStepsFrom:) ('*MorphicExtras-accessing') ('*MorphicExtras-geometry' shiftSubmorphsBy:) ('*MorphicExtras-menus' dismissButton printPSToFileNamed:) ('*services-base' requestor) ('private' canBeEncroached privateAddAllMorphs:atIndex: privateAddMorph:atIndex: privateBounds: privateColor: privateDeleteWithAbsolutelyNoSideEffects privateFullBounds: privateFullMoveBy: privateOwner: privateRemoveMorphWithAbsolutelyNoSideEffects: privateRemove: privateSubmorphs privateSubmorphs:) ('accessing-backstop' target:) ('e-toy support' adaptToWorld: allMorphsAndBookPagesInto: asNumber: automaticViewing currentPlayerDo: cursor cursor: decimalPlacesForGetter: defaultValueOrNil embeddedInMorphicWindowLabeled: embedInWindow getNumericValue gridFormOrigin:grid:background:line: handUserASibling isAViewer isTileEditor makeGraphPaper makeGraphPaperGrid:background:line: mustBeBackmost noteDecimalPlaces:forGetter: objectViewed referencePlayfield rotationStyle rotationStyle: setAsActionInButtonProperties: setNumericValue: setStandardTexture textureParameters unlockOneSubpart updateCachedThumbnail wantsRecolorHandle wrappedInWindowWithTitle: wrappedInWindow:) ('geniestubs' allowsGestureStart: isGestureStart: mouseStillDownStepRate redButtonGestureDictionaryOrName: yellowButtonGestureDictionaryOrName:) ('*morphic-Postscript Canvases' asPostscript fullDrawPostscriptOn: printPSToFile) ('player' assureExternalName okayToDuplicate shouldRememberCostumes) ('player commands' playSoundNamed:) ('button' doButtonAction) ('model access' models) ('player viewer' openViewerForArgument) ('other' removeAllButFirstSubmorph) ('selected object' selectedObject) ('polymorph' modalLockTo: modalUnlockFrom: openModal:) ('*Etoys-card in a stack' abstractAModel addStackItemsTo: assuredCardPlayer beAStackBackground becomeSharedBackgroundField containsCard: couldHoldSeparateDataForEachInstance currentDataInstance currentDataValue explainDesignations goToNextCardInStack goToPreviousCardInStack holdsSeparateDataForEachInstance insertAsStackBackground insertCard installAsCurrent: isStackBackground makeHoldSeparateDataForEachInstance newCard reassessBackgroundShape relaxGripOnVariableNames reshapeBackground setAsDefaultValueForNewCard showBackgroundObjects showDesignationsOfObjects showForegroundObjects stack stackDo: stopHoldingSeparateDataForEachInstance tabHitWithEvent: variableDocks wrapWithAStack) ('*Etoys' accumlatePlayersInto:andSelectorsInto: actorState addPlayerItemsTo: assuredPlayer boundsSignatureHash categoriesForViewer choosePenColor: choosePenSize currentVocabulary ensuredButtonProperties forward: getPenColor getPenDown getPenSize isPlayer:ofReferencingTile: isTurtleRow liftPen lowerPen moveWithPenDownBy: newPlayerInstance penColor: penUpWhile: putOnBackground putOnForeground scriptPerformer selectorsForViewer selectorsForViewerIn: showPlayerMenu trailMorph traverseRowTranslateSlotOld:of:to: traverseRowTranslateSlotOld:to: turn: understandsBorderVocabulary unfilteredCategoriesForViewer) ('*Etoys-support' adoptVocabulary: affiliatedSelector appearsToBeSameCostumeAs: asWearableCostume asWearableCostumeOfExtent: beep: buttonProperties buttonProperties: changeAllBorderColorsFrom:to: configureForKids copyCostumeStateFrom: creationStamp defaultVariableName definePath deletePath enclosingEditor enforceTileColorPolicy fenceEnabled fire firedMouseUpCode followPath getCharacters handMeTilesToFire hasButtonProperties isCandidateForAutomaticViewing jumpTo: listViewLineForFieldList: makeFenceSound noteNegotiatedName:for: pinkXButton restoreBaseGraphic set: slotSpecifications succeededInRevealing: tanOButton topEditor updateLiteralLabel) ('*Etoys-scripting' arrowDeltaFor: asEmptyPermanentScriptor bringTileScriptingElementsUpToDate bringUpToDate defaultFloatPrecisionFor: filterViewerCategoryDictionary: isTileLike isTileScriptingElement jettisonScripts makeAllTilesColored makeAllTilesGreen restoreTypeColor scriptEditorFor: tearOffTile triggerScript: useUniformTileColor viewAfreshIn:showingScript:at: wantsConnectionVocabulary) ('*Etoys-customevents-scripting' instantiatedUserScriptsDo: removeAllEventTriggers removeAllEventTriggersFor: removeEventTrigger: removeEventTrigger:for: renameScriptActionsFor:from:to: triggerCustomEvent: triggerEtoyEvent: triggerEtoyEvent:from:) ('*Rack-UI' openRackStandardMorph worldIconMorph worldIconText) ('*Etoys-geometry' addTransparentSpacerOfSize: cartesianBoundsTopLeft cartesianXY: color:sees: colorUnder degreesOfFlex forwardDirection: getIndexInOwner goHome heading heading: move:toPosition: scale: scaleFactor: setDirectionFrom: setIndexInOwner: simplySetVisible: touchesColor: transparentSpacerOfSize: wrap x x: x:y: y y:) ('*Etoys-latter day support' isEtoyReadout) ('*MorphicExtras-svg' asSVG clipPostscript drawPostscriptOn:) ('*MorphicExtras-postscript' asEPS asPostscriptPrintJob exportAsEPS exportAsEPSNamed:) ('*Morphic-Sound-piano rolls' addMorphsTo:pianoRoll:eventTime:betweenTime:and: encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: justDroppedIntoPianoRoll:event: pauseFrom: resetFrom: resumeFrom: triggerActionFromPianoRoll) ('*MorphicExtras' nextOwnerPage previousOwnerPage) ('events-filtering-bubbling' addEventBubbleFilter: addKeyboardBubbleFilter: addMouseBubbleFilter: eventBubbleFilters eventBubbleFilters: keyboardBubbleFilters keyboardBubbleFilters: mouseBubbleFilters mouseBubbleFilters: removeEventBubbleFilter: removeKeyboardBubbleFilter: removeMouseBubbleFilter:) ('events-filtering-capturing' addEventCaptureFilter: addKeyboardCaptureFilter: addMouseCaptureFilter: eventCaptureFilters eventCaptureFilters: keyboardCaptureFilters keyboardCaptureFilters: mouseCaptureFilters mouseCaptureFilters: removeEventCaptureFilter: removeKeyboardCaptureFilter: removeMouseCaptureFilter:) ('events-filtering' addFilter:to: eventFilterDocumentation removeFilter:from:) ('*AtomicPlants' isAtomicScale) ('*signals-morphic' emitInOwnerChain emitSignalInOwnerChain:arguments:sender: sgConnectSignal:to:selector: sgConnectSignal:to:selector:pattern: sgConnectSignal:toSelector: sgConnectSignal:toSelector:pattern: sgDisconnectSignal:from:selector: sgDisconnectSignal:fromSelector: signalConnectionsForOwnerChain) ('*animations-core' animations fullDrawAnimatedOn: hasAnimationRunning ignoresColorMappings ignoresColorMappings: redraw redrawLater transformedCanvasFrom:) ('*animations-examples' darken fadeIn fadeInThen: fadeOut fadeOutThen: lighten pulse walkToPosition: warpToPosition:) ('*animations-support' compositeAnimations darkenAnimation) ('*widgets-signals-processing' disconnectAllSignals hasSignalConnections signalConnections signalMutex) ('*widgets-events' enabled enabled: grabKeyboard grabMouse keyboardFocusChange:inSubmorph: releaseKeyboard releaseMouse) ('*widgets-geometry-override' extent: privateMoveBy:) ('*widgets-signals' extentChanged: positionChanged:) ('*widgets' frameFractions frameFractions: frameOffsets frameOffsets: fullDrawCacheOn: hideFull isTransformMorph isUiContainer showFull) ('*widgets-events-testing' hasAnyKeyboard hasKeyboard hasMouse hasSubmorphKeyboard) ('*widgets-geometry' visibleBounds) ('*vivide-layout' boundsInOwner: extentInOwner: gridCell gridCell: gridSpan gridSpan: topLeftInOwner:) ('*vivide' ide isOverlayConnector showFlash showFlashCross showFlashMini) ('*vivide-morphic' shrinkWrap) ('*skeleton-base-arrow' addHalo: arrowTargets showPointArrow showPointArrowFrom:to:label:) ('*skeleton-base-sheet' endHaloInteraction) ('*Pheno-Styles' addStyleClass: addStyleClasses: addedMorph: assureWidgetParent convertPaddingToRectangle: isWidget prepareToBeSaved removeStyleClass: resetStyleState styleClasses styleContext update: updateHierarchyStyleState updateStyleProperties updateStylePropertiesReal useCustomTheme: useGlobalTheme) ('*Etoys-Squeakland-halo notification' aboutToBeBrownDragged aboutToBeGrownViaHalo aboutToBeRotatedViaHalo aboutToBeScaledViaHalo brownDragConcluded growConcluded rotationConcluded scaleConcluded) ('*Etoys-Squeakland-menu & halo' addLockingItemsTo: menuButton offerMenu) ('*Etoys-Squeakland-WiW support' addMorphInLayer:centeredNear:) ('*Etoys-Squeakland-geometry' boundsInStagingArea collapsible spanContainerVertically: stagingArea) ('*Etoys-Squeakland-Etoys-SpeechBubbles' bubble bubble: say: sayGraphic: sayObject: showGraphic:inBubbleType: showMessage:inBubbleType: showObject:inBubbleType: stopSayingOrThinking think: thinkGraphic: thinkObject:) ('*Etoys-Squeakland-meta-actions' changeColorSimply changeColorTarget:selector:originalColor:hand:showPalette: embedEnabled openAppropriatePropertySheet showEmbedMenu targetFromMenu:popupAt:) ('*Etoys-Squeakland-visual properties' changeGraphPaper useGraphPaperFill) ('*Etoys-Squeakland-e-toy support' chosenColor: enclosingTestTile fixLayoutOfSubmorphs hideWillingnessToAcceptDropFeedback outmostScriptEditor putUpGraphPaperPanel removeViewersOnSubsIn: showWillingnessToAcceptDropFeedback unembedSubmorphsInWindow) ('*Etoys-Squeakland-accessing - extension' convertExtension) ('*Etoys-Squeakland-object fileIn' convertNovember2000DropShadow:using:) ('*Etoys-Squeakland-accessing' deepSubpartNamed: eventRoll) ('*Etoys-Squeakland-classification' defersHaloToInterior defersHaloToInteriorMorph: fontsForText) ('*Etoys-Squeakland-misc' doesColorAndBorder) ('*Etoys-Squeakland-display' editMenuButtonDefinition) ('*Etoys-Squeakland-latter day support' encouragesHaloTransferToEnclosedPasteUpMorph) ('*Etoys-Squeakland-viewing' establishGraphPaperFrom:) ('*Etoys-Squeakland-miscellaneous' finalTilePadSubmorph) ('*Etoys-Squeakland-other' fixUpCarets) ('*Etoys-Squeakland-debug and other' inspectMorphsProperties) ('*Etoys-Squeakland-layout' justAddedAsTileRow) ('*Etoys-Squeakland-drop outside' mimeTypes) ('*Etoys-Squeakland-initialization' naviHeight: openInWorldOrWorldlet openNearTopLeftOfScreen) ('*Etoys-Squeakland-submorphs-accessing' ownerSatisfying:) ('*Etoys-Squeakland-event roll' putEventsOnto: suitableForDroppingIntoEventRoll) ('*Etoys-Squeakland-structure' referenceWorld referenceWorldViaOwnwer) ('*Etoys-Squeakland-dropping/grabbing' repelEnabledForMorph:) ('*Etoys-Squeakland-geometry eToy' rotationDegrees:) ('*Etoys-Squeakland-fileIn/out' saveOnFile:) ('*Etoys-Squeakland-translation' traverseSearchForKedamaTurtleIfFound:) ('*Etoys-Squeakland-testing' isButton wantsGraphPaperAlternative) ('*Etoys-Squeakland-halos and balloon help') ('*60Deprecated-user-interface' becomeModal) ('*ToolBuilder-Morphic-opening' buildWith: openAsTool) ('*53Deprecated-dropping/grabbing') ('*60Deprecated-meta-actions' blueButtonDown: blueButtonUp: handlerForBlueButtonDown: handlerForMetaMenu:) ('*60Deprecated-accessing' doesBevels) ('*60Deprecated-MorphicExtras-accessing' highlightOnlySubmorph:) ('*GM-Keys' gmKeyHandler isKeyPressed:) ('*GM-Collision' collisionDetectionStrategy collisionDetectionStrategy:) ('*Squot-trackable' squotInitializeStoreInfo:) ('*GameMecha-Collisions' addToCollisionGroup: collisionBehavior collisionBehavior: collisionHandler collisionHandler: contains: intersectsWith: isCollider isObstacle markAsObstacle registerCollisionHandler: removeFromCollisionGroup: touches: unmarkAsObstacle) ('*GameMecha-Keys' registerKeyHandler:) ('*GM-Core' gmCollisionDetectionShape gmCollisionDetectionStrategy: gmDeregisterBlockForKey: gmDeregisterMethodInvocationForKey: gmEvaluateRegisteredEvents gmIsKeyPressed: gmRegisterBlock:forKey: gmRegisterMethodInvocation:on:forKey: gmRegisterToKeyHandler) ('*animations-control' deleteAnimations pauseAnimations resumeAnimations stopAnimations) ('*StarTrack-Client' openInHand openInWorld:) ('*60Deprecated-dropping/grabbing' toggleDragNDrop) ! BitBltDisplayScanner removeSelector: #displayEmbeddedForm:! DisplayScanner removeSelector: #displayEmbeddedForm:! DisplayScanner removeSelector: #placeEmbeddedObject:! CompositionScanner removeSelector: #placeEmbeddedObject:! CharacterBlockScanner removeSelector: #placeEmbeddedObject:! CharacterScanner subclass: #CharacterBlockScanner instanceVariableNames: 'characterPoint characterIndex nextLeftMargin lastCharacterWidth' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Text'! CharacterScanner removeSelector: #missingAttribute! CharacterScanner removeSelector: #placeEmbeddedObject:! !CharacterScanner reorganize! ('initialize' initialize) ('scanner methods' handleEndOfRunAt:) ('scanning' basicScanByteCharactersFrom:to:in:rightX: measureString:inFont:from:to: primScanCharactersFrom:to:in:rightX:stopConditions:kern: scanByteCharactersFrom:to:in:rightX: scanCharactersFrom:to:in:rightX: scanCharactersFrom:to:in:rightX:stopConditions:kern: scanKernableByteCharactersFrom:to:in:rightX:) ('private-text-anchor' missingTextAnchorAttribute startOfHeadingIcon) ('private' advanceIfFirstCharOfLine handleIndentation indentationLevel leadingTab placeEmbeddedObjectFrom: plainTab setFont setStopConditions text:textStyle:) ('*ST80-Support' initializeFromParagraph:clippedBy:) ('text attributes' addEmphasis: addKern: indentationLevel: setActualFont: setAlignment: setFont: textColor:) ('stop conditions' columnBreak embeddedObject) ('*45Deprecated' initializeStringMeasurer) ('*Multilingual-Display' isBreakableAt:in:in: registerBreakableIndex scanJapaneseCharactersFrom:to:in:rightX: scanKernableMultibyteCharactersFrom:to:in:rightX: scanMultibyteCharactersFrom:to:in:rightX:) !