SystemOrganization addCategory: #'OB-Morphic-Core'! SystemOrganization addCategory: #'OB-Morphic-Morphs'! !OBColumn methodsFor: '*ob-morphic' stamp: 'cwp 7/13/2007 20:59'! acceptDroppingMorph: transferMorph event: evt inMorph: listMorph | target | target := self nodeForDropEvent: evt inMorph: listMorph. ^self drop: transferMorph passenger on: target! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'avi 2/20/2004 13:45'! dragEnabled ^ true! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'cwp 7/13/2007 22:39'! dragPassengerFor: item inMorph: listMorph ^ self nodeForItem: item contents asString! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'avi 2/20/2004 14:37'! dragTransferType ^ #OmniBrowser! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'avi 2/20/2004 14:36'! dragTransferTypeForMorph: listMorph ^ self dragTransferType! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'avi 2/20/2004 14:30'! dropEnabled ^ true! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'dr 3/3/2008 16:32'! nodeForDropEvent: evt inMorph: pluggableListMorph | index item label | index := pluggableListMorph rowAtLocation: evt position. index = 0 ifTrue: [^nil]. item := pluggableListMorph listMorph item: index. label := item contents asString withBlanksTrimmed. ^self children detect: [:child | child displayString asString withBlanksTrimmed = label] ifNone: [nil]! ! !OBColumn methodsFor: '*ob-morphic' stamp: 'dr 11/18/2008 20:20'! wantsDroppedMorph: transferMorph event: evt inMorph: listMorph | node passenger | (transferMorph isKindOf: TransferMorph) ifFalse: [^false]. node := self nodeForDropEvent: evt inMorph: listMorph. transferMorph dragTransferType == self dragTransferType ifFalse: [^false]. passenger := transferMorph passenger. ^self canDrop: passenger on: node! ! PluggableTextMorph subclass: #OBPluggableTextMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBPluggableTextMorph commentStamp: 'cwp 12/7/2004 00:04' prior: 0! This is a trivial subclass of PluggableTextMorph. It overrides initialization methods to use an OBTextMorph rather than a regular TextMorph! !OBPluggableTextMorph methodsFor: 'model access' stamp: 'dkh 1/9/2009 10:58'! getColor "Use a fixed selector until we find the need to make the selector pluggable" ^model color! ! !OBPluggableTextMorph methodsFor: 'menu' stamp: 'dr 9/5/2008 11:28'! getMenu: shiftKeyState "Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key." | menu aMenu aTitle | getMenuSelector == nil ifTrue: [^ nil]. menu := MenuMorph new defaultTarget: model. aTitle := getMenuTitleSelector ifNotNil: [model perform: getMenuTitleSelector]. aMenu := model menu: menu shifted: shiftKeyState selection: self selectionNode. aTitle ifNotNil: [aMenu addTitle: aTitle]. ^ aMenu! ! !OBPluggableTextMorph methodsFor: 'event handling' stamp: 'cwp 10/30/2004 23:07'! keyStroke: evt ^ textMorph keyStroke: evt! ! !OBPluggableTextMorph methodsFor: 'access' stamp: 'dr 12/15/2008 19:09'! selectionNode ^ OBTextSelection on: self selectionInterval inText: self text! ! !OBPluggableTextMorph methodsFor: 'model access' stamp: 'cwp 10/30/2004 22:57'! setText: aText scrollBar setValue: 0.0. textMorph ifNil: [textMorph := OBTextMorph new contents: aText wrappedTo: self innerBounds width-6. textMorph setEditView: self. scroller addMorph: textMorph] ifNotNil: [textMorph newContents: aText]. self hasUnacceptedEdits: false. self setScrollDeltas.! ! !OBPluggableTextMorph methodsFor: 'updating' stamp: 'dkh 1/9/2009 11:01'! update: aSymbol super update: aSymbol. aSymbol == #color ifTrue: [ ^self color: self getColor ]. aSymbol == #displayWorld ifTrue: [ ^self currentWorld displayWorld ]! ! OBPluggableTextMorph subclass: #OBPluggableTextMorphWithShout instanceVariableNames: 'styler unstyledAcceptText' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBPluggableTextMorphWithShout class methodsFor: 'instance creation' stamp: 'tween 4/24/2007 16:28'! on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel |styler answer stylerClass | answer := self new. stylerClass := Smalltalk classNamed: #SHTextStylerST80. styler := stylerClass ifNotNil:[ stylerClass new view: answer; yourself]. ^ answer styler: styler; on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel! ! !OBPluggableTextMorphWithShout methodsFor: 'accepting' stamp: 'tween 3/15/2007 14:00'! acceptTextInModel self okToStyle ifFalse:[^super acceptTextInModel]. "#correctFrom:to:with: is sent when the method source is manipulated during compilation (removing unused temps, changing selectors etc). But #correctFrom:to:with: operates on the textMorph's text, and we may be saving an unstyled copy of the text. This means that these corrections will be lost unless we also apply the corrections to the unstyled copy that we are saving. So remember the unstyled copy in unstyledAcceptText, so that when #correctFrom:to:with: is received we can also apply the correction to it" unstyledAcceptText := styler unstyledTextFrom: textMorph asText. [^setTextSelector isNil or: [setTextSelector numArgs = 2 ifTrue: [model perform: setTextSelector with: unstyledAcceptText with: self] ifFalse: [model perform: setTextSelector with: unstyledAcceptText]] ] ensure:[unstyledAcceptText := nil]! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:00'! classOrMetaClass: aBehavior "set the classOrMetaClass in the receiver's styler to aBehavior" styler classOrMetaClass: aBehavior ! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:00'! correctFrom: start to: stop with: aString "see the comment in #acceptTextInModel " unstyledAcceptText ifNotNil:[unstyledAcceptText replaceFrom: start to: stop with: aString ]. ^ super correctFrom: start to: stop with: aString! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:00'! environment: anObject "set the environment in the receiver's styler to anObject" styler environment: anObject ! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:00'! font: aFont super font: aFont. styler ifNotNil: [styler font: aFont]! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:01'! hasUnacceptedEdits: aBoolean "re-implemented to re-style the text iff aBoolean is true" super hasUnacceptedEdits: aBoolean. (aBoolean and: [self okToStyle]) ifTrue: [ styler styleInBackgroundProcess: textMorph contents]! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:01'! okToStyle styler ifNil:[^false]. Preferences syntaxHighlightingAsYouType ifFalse: [^false]. (model respondsTo: #shoutAboutToStyle: ) ifFalse:[^true]. ^model shoutAboutToStyle: self ! ! !OBPluggableTextMorphWithShout methodsFor: 'private' stamp: 'tween 3/15/2007 14:14'! privateSetText: aText scrollBar setValue: 0.0. textMorph ifNil: [textMorph := self textMorphClass new contents: aText wrappedTo: self innerBounds width-6. textMorph setEditView: self. scroller addMorph: textMorph] ifNotNil: [textMorph newContents: aText]. self hasUnacceptedEdits: false. self setScrollDeltas.! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:14'! setText: aText self okToStyle ifFalse:[^self privateSetText: aText]. self privateSetText: (styler format: aText asText). aText size < 4096 ifTrue:[ styler style: textMorph contents] ifFalse:[styler styleInBackgroundProcess: textMorph contents] ! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:01'! sourceMap: aSortedCollection "set the sourceMap in the receiver's styler to aSortedCollection" styler sourceMap: aSortedCollection ! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:01'! styler ^styler ! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:02'! styler: anObject styler := anObject ! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 11/16/2007 07:17'! stylerStyled: styledCopyOfText textMorph contents runs: styledCopyOfText runs . "textMorph paragraph recomposeFrom: 1 to: textMorph contents size delta: 0." "caused chars to appear in wrong order esp. in demo mode. remove this line when sure it is fixed" textMorph updateFromParagraph. selectionInterval ifNotNil:[ textMorph editor selectInvisiblyFrom: selectionInterval first to: selectionInterval last; storeSelectionInParagraph; setEmphasisHere]. textMorph editor blinkParen. self scrollSelectionIntoView! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:02'! stylerStyledInBackground: styledCopyOfText "It is possible that the text string has changed since the styling began. Disregard the styles if styledCopyOfText's string differs with the current textMorph contents string" textMorph contents string = styledCopyOfText string ifTrue: [self stylerStyled: styledCopyOfText] ! ! !OBPluggableTextMorphWithShout methodsFor: 'private' stamp: 'tween 3/15/2007 14:15'! textMorphClass "Answer the class used to create the receiver's textMorph" ^OBTextMorphWithShout! ! !OBPluggableTextMorphWithShout methodsFor: 'styler' stamp: 'tween 3/15/2007 14:02'! workspace: anObject "set the workspace in the receiver's styler to anObject" styler workspace: anObject ! ! TextMorphEditor subclass: #OBTextMorphEditor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBTextMorphEditor commentStamp: 'cwp 1/7/2005 23:27' prior: 0! OBTextMorphEditor overrides the TextMorphEditors handling of command keys, passing them along to its model for processing, rather than hard-coding their implementations.! !OBTextMorphEditor methodsFor: 'actions' stamp: 'alain.plantec 6/18/2008 09:10'! browseIt | symbol | self lineSelectAndEmptyCheck: [^ self]. (symbol := self selectedSymbol) isNil ifTrue: [^ self flash]. self send: #browseIt: toModelWith: {symbol} orDo: [super browseIt]! ! !OBTextMorphEditor methodsFor: 'actions' stamp: 'alain.plantec 6/18/2008 09:10'! implementorsOfIt "Open a senders browser on the selected selector" | selector | self lineSelectAndEmptyCheck: [^ self]. (selector := self selectedSelector) == nil ifTrue: [^ self flash]. self send: #implementorsOfIt: toModelWith: {selector} orDo: [super sendersOfIt]! ! !OBTextMorphEditor methodsFor: 'actions' stamp: 'alain.plantec 6/18/2008 09:10'! referencesToIt | selector | self lineSelectAndEmptyCheck: [^ self]. (selector := self selectedSelector) == nil ifTrue: [^ self flash]. self send: #referencesToIt: toModelWith: {selector} orDo: [super referencesToIt]! ! !OBTextMorphEditor methodsFor: 'model access' stamp: 'alain.plantec 6/18/2008 09:10'! send: aSelector toModelWith: args orDo: aBlock self terminateAndInitializeAround: [(model respondsTo: aSelector) ifTrue: [(model perform: aSelector withArguments: args) ifFalse: [self flash]] ifFalse: aBlock]! ! !OBTextMorphEditor methodsFor: 'actions' stamp: 'alain.plantec 6/18/2008 09:10'! sendersOfIt "Open a senders browser on the selected selector" | selector | self lineSelectAndEmptyCheck: [^ self]. (selector := self selectedSelector) == nil ifTrue: [^ self flash]. self send: #sendersOfIt: toModelWith: {selector} orDo: [super sendersOfIt]! ! OBTextMorphEditor subclass: #OBTextMorphEditorWithShout instanceVariableNames: 'inBackTo' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBTextMorphEditorWithShout methodsFor: 'backspace handling' stamp: 'tween 3/15/2007 14:16'! backTo: startIndex "When backspacing, 2 notifications of the userHasEdited are received. This then causes a background process to not terminate correctly. The reason for all this is uncertain, but discarding the superfluous userHasEdited message received while running backTo: seems to cure the problem" | answer | [inBackTo := true. answer := super backTo: startIndex ] ensure:[ inBackTo:=false. ^answer] ! ! !OBTextMorphEditorWithShout methodsFor: 'parenblinking' stamp: 'tween 3/15/2007 14:17'! blinkParen lastParentLocation ifNotNil: [self text string size >= lastParentLocation ifTrue: [ self text addAttribute: TextEmphasis bold from: lastParentLocation to: lastParentLocation]] ! ! !OBTextMorphEditorWithShout methodsFor: 'new selection' stamp: 'tween 3/15/2007 14:18'! changeEmphasis: characterStream morph editView styler evaluateWithoutStyling: [^super changeEmphasis: characterStream]! ! !OBTextMorphEditorWithShout methodsFor: 'parenblinking' stamp: 'tween 3/15/2007 14:18'! clearParens super clearParens. lastParentLocation := nil ! ! !OBTextMorphEditorWithShout methodsFor: 'backspace handling' stamp: 'tween 3/15/2007 14:16'! userHasEdited "ignore this if generated during backTo: See comment in backTo: " (inBackTo isNil or: [inBackTo not]) ifTrue:[^super userHasEdited] ! ! !OBCodeNode methodsFor: '*ob-morphic' stamp: 'dr 8/21/2008 15:11'! shouldBeStyledBy: aShoutMorph aShoutMorph classOrMetaClass: nil. ^false! ! RectangleMorph subclass: #OBButtonBar instanceVariableNames: 'model' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBButtonBar class methodsFor: 'as yet unclassified' stamp: 'cwp 3/11/2007 16:39'! on: aModel ^ self new model: aModel; initGeometry; update: #commands.! ! !OBButtonBar methodsFor: 'updating' stamp: 'dc 9/8/2007 15:02'! addButtonFor: aCommand self addMorphBack: ((self buttonFor: aCommand) position: self position; yourself)! ! !OBButtonBar methodsFor: 'visual' stamp: 'cwp 3/11/2007 20:55'! adoptPaneColor: aColor self submorphs do: [:ea | ea onColor: aColor offColor: aColor whiter]! ! !OBButtonBar methodsFor: 'updating' stamp: 'dc 9/27/2007 14:46'! buttonFor: aCommand | buttonColor | buttonColor := model color duller. ^ (PluggableButtonMorph on: aCommand getState: #isActive action: (aCommand isActive ifTrue: [#execute] ifFalse: [#yourself]) label: #buttonLabel) onColor: buttonColor offColor: buttonColor whiter; hResizing: #spaceFill; vResizing: #spaceFill; styleWith: OBMorphBuilder new; setBalloonText: aCommand longDescription; yourself ! ! !OBButtonBar methodsFor: 'initialize-release' stamp: 'cwp 7/21/2007 22:32'! initGeometry self layoutPolicy: TableLayout new; listDirection: #leftToRight; hResizing: #spaceFill; vResizing: #spaceFill; rubberBandCells: true; styleWith: OBMorphBuilder new; yourself! ! !OBButtonBar methodsFor: 'accessing' stamp: 'cwp 3/11/2007 15:56'! model ^ model! ! !OBButtonBar methodsFor: 'accessing' stamp: 'cwp 3/11/2007 15:26'! model: aModel model ifNotNil: [model removeDependent: self]. model := aModel. model addDependent: self.! ! !OBButtonBar methodsFor: 'visual' stamp: 'cwp 3/11/2007 20:34'! noteNewOwner: aMorph | window | window := aMorph containingWindow. window ifNotNil: [self adoptPaneColor: window paneColor]! ! !OBButtonBar methodsFor: 'building' stamp: 'cwp 7/21/2007 21:35'! styleWith: aBuilder aBuilder styleButtonBar: self! ! !OBButtonBar methodsFor: 'updating' stamp: 'cwp 3/11/2007 15:58'! update: aSymbol aSymbol == #commands ifTrue: [self updateCommands]! ! !OBButtonBar methodsFor: 'updating' stamp: 'cwp 3/11/2007 19:27'! updateCommands self removeAllMorphs. model commands do: [:ea | self addButtonFor: ea]. ! ! RectangleMorph subclass: #OBGroupingMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBGroupingMorph methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2007 12:03'! addBorders self borderWidth: 0. self submorphs do: [:morph | morph class = self class ifTrue: [morph addBorders] ifFalse: [morph adoptPaneColor: color. morph borderWidth: 2; borderColor: #inset; color: Color transparent]]! ! !OBGroupingMorph methodsFor: 'as yet unclassified' stamp: 'cwp 12/9/2007 10:50'! addMorph: aMorph frame: relFrame "Stole this from SystemWindow" | frame | frame := LayoutFrame new. frame leftFraction: relFrame left; rightFraction: relFrame right; topFraction: relFrame top; bottomFraction: relFrame bottom. self addMorph: aMorph fullFrame: frame. ! ! !OBGroupingMorph methodsFor: 'as yet unclassified' stamp: 'lr 1/22/2008 20:08'! initialize super initialize. self borderWidth: 0. self color: Color transparent! ! RectangleMorph subclass: #OBPane instanceVariableNames: 'model list button' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBPane commentStamp: 'cwp 1/7/2005 23:24' prior: 0! An OBPane is the visual representation of a column in a browser. It contains a morph to display nodes (typically a PluggableListMorph) and (optionally) a morph for communicating with the column's filter. It's main responsibility is to lay out its submorphs as the filter controls are added and removed. iVars: model - the OBColumn that controls the node list displayed in this pane list - the morph which displays the node list, usually a PluggableListMorph button - the morph which controls the column's filter, usually an OBRadioButtonBar.! !OBPane methodsFor: 'updating' stamp: 'cwp 11/2/2004 00:53'! addButton: aButton self hasButton ifTrue: [self removeMorph: button]. button := aButton. button height: self defaultButtonHeight. self addMorph: button; adjustList; adjustButton! ! !OBPane methodsFor: 'updating' stamp: 'cwp 3/14/2007 23:33'! addList: aListMorph list := aListMorph. self addMorph: list. list bounds: self innerBounds. ! ! !OBPane methodsFor: 'updating' stamp: 'cwp 5/17/2007 23:56'! adjustButton | inner | self hasButton ifTrue: [inner := self innerBounds. button bounds: (inner withTop: inner bottom - button height)]! ! !OBPane methodsFor: 'updating' stamp: 'cwp 3/14/2007 23:26'! adjustList self hasButton ifFalse: [self list bounds: self innerBounds] ifTrue: [self list bounds: (self innerBounds withHeight: (self height - self buttonHeight))]! ! !OBPane methodsFor: 'geometry' stamp: 'cwp 2/12/2004 18:32'! bounds: aRectangle super bounds: aRectangle. self adjustList. self adjustButton.! ! !OBPane methodsFor: 'accessing' stamp: 'cwp 3/14/2007 23:28'! button ^ button! ! !OBPane methodsFor: 'constructing' stamp: 'cwp 5/18/2007 00:02'! buttonFor: aSwitch ^ aSwitch buildOn: OBMorphBuilder new ! ! !OBPane methodsFor: 'constructing' stamp: 'cwp 11/2/2004 00:57'! buttonHeight ^ self hasButton ifTrue: [button height] ifFalse: [self defaultButtonHeight] ! ! !OBPane methodsFor: 'constructing' stamp: 'cwp 11/2/2004 01:10'! defaultButtonHeight ^ 23! ! !OBPane methodsFor: 'testing' stamp: 'cwp 2/12/2004 18:35'! hasButton ^ button notNil! ! !OBPane methodsFor: 'initialization' stamp: 'cwp 3/14/2007 23:42'! initGeometry self hResizing: #spaceFill; vResizing: #spaceFill; clipSubmorphs: true; color: Color transparent; cellInset: 0; borderWidth: 0; layoutPolicy: ProportionalLayout new. ! ! !OBPane methodsFor: 'accessing' stamp: 'cwp 3/14/2007 23:42'! list ^ list! ! !OBPane methodsFor: 'initialization' stamp: 'cwp 2/12/2004 18:44'! model: anObject "Set my model and make me me a dependent of the given object." model ifNotNil: [model removeDependent: self]. anObject ifNotNil: [anObject addDependent: self]. model := anObject. ! ! !OBPane methodsFor: 'constructing' stamp: 'cwp 11/27/2004 21:19'! noteNewOwner: aMorph self containingWindow ifNotNilDo: [:window | self adoptPaneColor: window paneColor]! ! !OBPane methodsFor: 'updating' stamp: 'cwp 2/12/2004 20:29'! removeButton self hasButton ifTrue: [self removeMorph: button. button := nil. self adjustList]! ! !OBPane methodsFor: 'updating' stamp: 'cwp 5/18/2007 23:09'! update: aSelector aSelector = #switch ifFalse: [^ self]. self hasButton = model wantsButton ifTrue: [^ self]. model wantsButton ifTrue: [self addButton: (self buttonFor: model switch)] ifFalse: [self removeButton]! ! RectangleMorph subclass: #OBPaneScroller instanceVariableNames: 'model sizing panes transform scrollBar' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBPaneScroller commentStamp: 'cwp 3/5/2004 12:13' prior: 0! Instances of OBPaneScroller contain the panes which represent columns in a browser. Their primary responsibilities are laying out panes to fit the space available and scrolling them horizontally when there isn't sufficient space. iVars: sizing - The number of panes which should exactly fit the available space. During layout, the width of the panes is determined accordingly. transform - A TransformMorph used for scrolling scrollBar - An OBHorizontalScrollBar used for scrolling! !OBPaneScroller class methodsFor: 'as yet unclassified' stamp: 'cwp 11/17/2004 22:01'! withModel: aModel ^ self new model: aModel! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/8/2004 11:10'! adjustPaneHeight "This gets called after the scrollbar has been shown or hidden, to move the bottom of the panes to the right place." transform bounds: self innerBounds. transform submorphsDo: [:m | m bounds: (m bounds withHeight: self paneHeight)] ! ! !OBPaneScroller methodsFor: 'private' stamp: 'dr 9/24/2008 14:01'! basicUpdatePanes | builder | builder := OBMorphBuilder new. panes := model ifNil: [Array new] ifNotNil: [model columns collect: [:ea | ea buildOn: builder]]. self clearPanes. panes do: [:ea | self pushPane: ea]. ! ! !OBPaneScroller methodsFor: 'private' stamp: 'cwp 11/23/2004 01:14'! basicUpdateSizing model ifNil: [sizing := 1] ifNotNil: [sizing := model sizing]! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 11/21/2004 23:45'! bounds: aRectangle super bounds: aRectangle. self layoutWidgets. self layoutPanes. self setScrollDeltas. ! ! !OBPaneScroller methodsFor: 'panes' stamp: 'cwp 12/6/2003 17:06'! clearPanes transform removeAllMorphs! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/26/2004 23:14'! computeMorphWidths | paneWidths widths | paneWidths := self paneWidthsToFit: self totalPaneWidth. widths := OrderedCollection new. paneWidths do: [:w | widths add: w] separatedBy: [widths add: self separatorWidth]. ^ widths asArray ! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/8/2004 11:06'! doLayout self layoutWidgets. self layoutPanes. self hideOrShowScrollBar. self setScrollDeltas. self scrollToRight.! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 2/8/2004 10:44'! hideOrShowScrollBar self isScrollable ifTrue: [self showScrollBar] ifFalse: [self hideScrollBar]! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 2/8/2004 11:10'! hideScrollBar self removeMorph: scrollBar. self adjustPaneHeight.! ! !OBPaneScroller methodsFor: 'initialization' stamp: 'cwp 5/28/2007 01:30'! initialize super initialize. self color: Color white; borderWidth: 0; vResizing: #spaceFill; hResizing: #spaceFill. self initializeTransform; initializeScrollbar.! ! !OBPaneScroller methodsFor: 'initialization' stamp: 'cwp 2/8/2004 11:01'! initializeScrollbar scrollBar := OBScrollBar new model: self slotName: 'scrollBar'. scrollBar borderWidth: 0; borderColor: #inset; height: self scrollBarHeight. self resizeScrollBar. ! ! !OBPaneScroller methodsFor: 'initialization' stamp: 'cwp 2/8/2004 10:52'! initializeTransform transform := TransformMorph new. transform color: Color transparent; borderWidth: 0; vResizing: #spaceFill; hResizing: #spaceFill; disableTableLayout; bounds: super innerBounds. self addMorphBack: transform. ! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/8/2004 10:54'! innerBounds | rect | rect := super innerBounds. ^ self scrollBarIsVisible ifTrue: [rect withHeight: rect height - self scrollBarHeight - 1] ifFalse: [rect]! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 2/8/2004 10:42'! isScrollable ^ self leftoverScrollRange > 0! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/8/2004 01:22'! layoutPanes | widths rect | widths := self computeMorphWidths. rect := 0@0 extent: (0 @ self paneHeight). transform submorphs with: widths do: [:m :w | rect := rect withWidth: w. m bounds: rect. rect := rect translateBy: (w@0)] ! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 8/25/2003 22:13'! layoutWidgets | inner outer | outer := super innerBounds. inner := self innerBounds. transform bounds: inner. scrollBar bounds: ((inner left @ inner bottom + 1) corner: outer bottomRight)! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 8/25/2003 21:04'! leftoverScrollRange ^ (self totalScrollRange - self innerBounds width roundTo: self scrollDeltaWidth) max: 0 ! ! !OBPaneScroller methodsFor: 'accessing' stamp: 'cwp 11/17/2004 22:03'! model ^model! ! !OBPaneScroller methodsFor: 'accessing' stamp: 'cwp 11/17/2004 22:11'! model: anObject model ifNotNil: [model removeDependent: self]. anObject ifNotNil: [anObject addDependent: self]. model := anObject! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 11/17/2004 23:09'! paneCount ^ self panes size! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 12/6/2003 17:08'! paneHeight ^ transform bounds height! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/26/2004 23:14'! paneWidthsToFit: limit | padded | padded := Array new: self paneCount. padded atAllPut: (limit / self sizing) floor. (1 to: limit - padded sum) do: [:i | padded at: i put: (padded at: i) + 1]. ^ padded ! ! !OBPaneScroller methodsFor: 'accessing' stamp: 'cwp 11/17/2004 23:09'! panes ^ panes ifNil: [self updatePanes. panes]! ! !OBPaneScroller methodsFor: 'panes' stamp: 'cwp 11/23/2004 01:22'! popPanes: count count * 2 timesRepeat: [transform removeMorph: transform lastSubmorph]. panes removeLast: count! ! !OBPaneScroller methodsFor: 'panes' stamp: 'cwp 11/17/2004 22:46'! pushPane: aMorph aMorph borderWidth: 0; hResizing: #rigid; vResizing: #rigid; layoutInset: 0. transform hasSubmorphs ifTrue: [transform addMorphBack: self separator]. transform addMorphBack: aMorph. ! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/8/2004 11:03'! resizeScrollBar | inner outer | outer := super innerBounds. inner := outer withHeight: outer height - self scrollBarHeight - 1. scrollBar bounds: ((inner left @ inner bottom + 1) corner: outer bottomRight)! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 8/24/2003 14:29'! scrollBarHeight ^ 12! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 2/8/2004 10:56'! scrollBarIsVisible ^ submorphs includes: scrollBar! ! !OBPaneScroller methodsFor: 'updating' stamp: 'cwp 11/21/2004 13:51'! scrollBarValue: value transform hasSubmorphs ifFalse: [^ self]. transform offset: (self leftoverScrollRange * value) rounded @ 0.! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 8/23/2003 16:21'! scrollDeltaWidth ^ 1! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 12/8/2003 21:42'! scrollToRight ^ scrollBar setValue: 1.! ! !OBPaneScroller methodsFor: 'panes' stamp: 'cwp 7/21/2007 22:32'! separator ^ BorderedSubpaneDividerMorph vertical color: model defaultBackgroundColor duller; styleWith: OBMorphBuilder new; yourself! ! !OBPaneScroller methodsFor: 'defaults' stamp: 'cwp 7/21/2007 22:45'! separatorWidth ^ OBMorphBuilder new style39 ifTrue: [3] ifFalse: [4]! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 8/25/2003 21:14'! setScrollDeltas | range interval value | transform hasSubmorphs ifFalse: [scrollBar interval: 1.0. ^ self]. range := self leftoverScrollRange. range = 0 ifTrue: [^ scrollBar interval: 1.0; setValue: 0]. interval := ((self innerBounds width) / self totalScrollRange) asFloat. value := (transform offset x / range min: 1.0) asFloat. scrollBar interval: interval. scrollBar setValue: value.! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 2/8/2004 11:11'! showScrollBar self scrollBarIsVisible ifTrue: [^ self]. self resizeScrollBar. self addMorphFront: scrollBar. self adjustPaneHeight. ! ! !OBPaneScroller methodsFor: 'accessing' stamp: 'cwp 11/22/2004 23:19'! sizing ^ sizing ifNil: [self updateSizing]! ! !OBPaneScroller methodsFor: 'layout' stamp: 'cwp 2/25/2004 20:23'! totalPaneWidth ^ self innerBounds width - ((self sizing - 1) * self separatorWidth)! ! !OBPaneScroller methodsFor: 'scrolling' stamp: 'cwp 8/25/2003 19:27'! totalScrollRange | submorphBounds | submorphBounds := transform localSubmorphBounds ifNil: [^ 0]. ^ submorphBounds width ! ! !OBPaneScroller methodsFor: 'updating' stamp: 'cwp 3/25/2007 00:23'! update: aSymbol aSymbol = #sizing ifTrue: [^ self updateSizing]. aSymbol = #columns ifTrue: [^ self updatePanes].! ! !OBPaneScroller methodsFor: 'updating' stamp: 'cwp 11/23/2004 01:34'! updatePanes | count | model ifNil: [panes := Array new. ^ self]. count := panes ifNotNil: [panes size] ifNil: [0]. self basicUpdatePanes. self basicUpdateSizing. self layoutPanes. panes size = count ifFalse: [self hideOrShowScrollBar. self setScrollDeltas]. panes size > count ifTrue: [self scrollToRight]. ^ panes! ! !OBPaneScroller methodsFor: 'updating' stamp: 'cwp 11/23/2004 01:14'! updateSizing | old | old := sizing. self basicUpdateSizing. sizing = old ifFalse: [self layoutPanes]. ^sizing! ! RectangleMorph subclass: #OBRadioButtonBar instanceVariableNames: 'model buttons getListSelector selection getSelectionSelector setSelectionSelector' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBRadioButtonBar commentStamp: 'cwp 1/7/2005 23:27' prior: 0! An OBRadioButtonBar is similar to a PluggableListMorph except that it displays a row of buttons rather than a vertical list. Clicking on a button selects it. model - the model for this button bar buttons - a collection of OBButtonModels, which are derived from the model's list selection - the index of the currently selected button getListSelector - the message for getting the list of labels for the buttons getSelectionSelector - the message for getting the index of the currently selected item setSelectionSelector - the message for informing the model that a button has been clicked! !OBRadioButtonBar class methodsFor: 'as yet unclassified' stamp: 'cwp 2/22/2004 16:44'! on: aModel list: listSelector selected: selectionSelector changeSelected: changedSelector ^ self new on: aModel list: listSelector selected: selectionSelector changeSelected: changedSelector! ! !OBRadioButtonBar methodsFor: 'constructing' stamp: 'cwp 5/18/2007 22:12'! adoptPaneColor: aColor color := aColor. self updateSubmorphColor! ! !OBRadioButtonBar methodsFor: 'accessing' stamp: 'dr 10/21/2008 13:19'! getLabels ^model perform: getListSelector ! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 2/24/2004 18:53'! getSelectionIndex ^ model perform: getSelectionSelector! ! !OBRadioButtonBar methodsFor: 'initialize-release' stamp: 'cwp 7/21/2007 22:33'! initGeometry self layoutPolicy: TableLayout new; listDirection: #leftToRight; hResizing: #spaceFill; vResizing: #spaceFill; rubberBandCells: true; styleWith: OBMorphBuilder new! ! !OBRadioButtonBar methodsFor: 'callbacks' stamp: 'dr 7/19/2007 15:17'! isEnabled: aButton ^model isEnabled: aButton! ! !OBRadioButtonBar methodsFor: 'callbacks' stamp: 'cwp 2/24/2004 18:54'! isSelected: aButton ^ (buttons at: selection ifAbsent: [^ false]) == aButton! ! !OBRadioButtonBar methodsFor: 'accessing' stamp: 'dr 10/21/2008 13:19'! list buttons ifNil: [| labels | labels := self getLabels. buttons := Array new: labels size. labels withIndexDo: [:label :index | buttons at: index put: (OBButtonModel withLabel: label inBar: self)]. selection := self getSelectionIndex. self]. ^buttons collect: [:b | b label]! ! !OBRadioButtonBar methodsFor: 'accessing' stamp: 'cwp 3/11/2007 15:33'! model: aModel model ifNotNil: [model removeDependent: self]. model := aModel. model addDependent: self.! ! !OBRadioButtonBar methodsFor: 'constructing' stamp: 'cwp 11/27/2004 21:02'! noteNewOwner: aMorph | window | window := aMorph containingWindow. window ifNotNil: [self adoptPaneColor: window paneColor]! ! !OBRadioButtonBar methodsFor: 'initialize-release' stamp: 'cwp 2/25/2004 00:36'! on: aModel list: listSelector selected: selectionGetter changeSelected: selectionSetter self model: aModel. selection := 0. getListSelector := listSelector. getSelectionSelector := selectionGetter. setSelectionSelector := selectionSetter. self initGeometry. self updateList.! ! !OBRadioButtonBar methodsFor: 'callbacks' stamp: 'cwp 2/24/2004 18:47'! push: aButton | index | index := buttons indexOf: aButton. model perform: setSelectionSelector with: index.! ! !OBRadioButtonBar methodsFor: 'constructing' stamp: 'cwp 7/21/2007 21:54'! styleWith: aBuilder aBuilder styleButtonBar: self! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 2/25/2004 00:35'! update: aSymbol aSymbol = getListSelector ifTrue: [self updateList. ^ self]. aSymbol = getSelectionSelector ifTrue: [self updateSelection]! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'dr 10/21/2008 13:19'! updateButtons | labels | labels := self getLabels. buttons := Array new: labels size. labels withIndexDo: [:label :index | buttons at: index put: (OBButtonModel withLabel: label inBar: self)]. selection := self getSelectionIndex! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 11/27/2004 17:58'! updateList self updateButtons; updateMorphs! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 5/18/2007 22:16'! updateMorphs self removeAllMorphs. buttons do: [:button | self addMorphBack: (OBMorphBuilder build: button)]. self updateSubmorphColor ! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 2/24/2004 19:39'! updateSelection | oldSelection | oldSelection := selection. selection := self getSelectionIndex. self withButtonAt: oldSelection do: [:button | button selectionChanged]. self withSelectedButtonDo: [:button | button selectionChanged]! ! !OBRadioButtonBar methodsFor: 'constructing' stamp: 'cwp 5/18/2007 22:17'! updateSubmorphColor self submorphs do: [:ea | ea onColor: color darker offColor: color lighter]! ! !OBRadioButtonBar methodsFor: 'constructing' stamp: 'cwp 5/18/2007 22:12'! updateSubmorphs self submorphs do: [:ea | ea onColor: color darker offColor: color lighter]! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 7/9/2007 23:39'! withButtonAt: index do: aBlock ^ aBlock value: (buttons at: index ifAbsent: [^ self]) ! ! !OBRadioButtonBar methodsFor: 'updating' stamp: 'cwp 2/24/2004 19:38'! withSelectedButtonDo: aBlock ^ self withButtonAt: selection do: aBlock! ! OBPlatform subclass: #OBMorphicPlatform instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Core'! !OBMorphicPlatform class methodsFor: 'as yet unclassified' stamp: 'cwp 6/1/2007 16:10'! default ^ self new! ! !OBMorphicPlatform methodsFor: 'preferences' stamp: 'cwp 7/1/2007 17:07'! enableGently: aSymbol ^ Preferences enableGently: aSymbol! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'cwp 6/1/2007 16:50'! handleBrowseRequest: request ^ OBMorphBuilder open: request browser! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'dc 9/18/2007 10:48'! handleChoiceRequest: request ^ UIManager default chooseFrom: request labels values: request values lines: request lines title: (request prompt ifNil: [''])! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'avi 12/5/2007 13:20'! handleCloseRequest: request (SystemWindow allInstances detect: [:ea | ea model = request browser] ifNone: []) ifNotNilDo: [:sw | sw delete]! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'dc 9/18/2007 15:57'! handleConfirmationRequest: request ^ UIManager default chooseFrom: {request okChoice. request cancelChoice} values: {true. false} title: request prompt.! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'dkh 1/14/2008 12:20'! handleDirectoryRequest: request | fileDirectory | fileDirectory := UIManager default chooseDirectory. fileDirectory == nil ifTrue: [ ^nil ]. ^fileDirectory pathName! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'dc 7/22/2007 20:32'! handleInformRequest: anOBInformRequest self inform: anOBInformRequest message! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'dkh 12/22/2008 12:25'! handleMultiLineTextRequest: request ^UIManager default multiLineRequest: request prompt centerAt: Sensor cursorPoint initialAnswer: request template answerHeight: 200! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'lr 4/5/2008 13:02'! handleMultipleChoiceRequest: aRequest | menu | aRequest values isEmpty ifTrue: [ ^ aRequest values ]. menu := MenuMorph new. menu stayUp: true. aRequest prompt isEmptyOrNil ifFalse: [ menu addTitle: aRequest prompt ]. aRequest values do: [ :value | menu addUpdating: #label: target: aRequest selector: #toggle: argumentList: (Array with: value) ]. menu addLine. menu add: 'ok' target: menu selector: #delete. menu invokeModal. ^ aRequest selection asArray! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'dc 9/18/2007 16:01'! handleTextRequest: request | text | text := UIManager default request:request prompt initialAnswer: request template. ^ text ifEmpty: [nil] ifNotEmpty: [text]! ! !OBMorphicPlatform methodsFor: 'interaction' stamp: 'lr 5/14/2008 15:42'! handleWaitRequest: request ^ Cursor wait showWhile: request block! ! !OBMorphicPlatform methodsFor: 'preferences' stamp: 'cwp 7/1/2007 16:46'! menuWithIcons ^ Preferences menuWithIcons! ! !OBMorphicPlatform methodsFor: 'preferences' stamp: 'cwp 7/1/2007 16:41'! optionalButtons ^ Preferences optionalButtons ! ! !OBMorphicPlatform methodsFor: 'preferences' stamp: 'cwp 7/1/2007 17:09'! setPreference: aSymbol toValue: anObject ^ Preferences setPreference: aSymbol toValue: anObject! ! TextMorphForEditView subclass: #OBTextMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBTextMorph commentStamp: 'cwp 12/7/2004 00:07' prior: 0! This is a trivial subclass of TextMorph. It overrides editor creation to use OBTextMorphEditor rather than a regular TextMorphEditor.! !OBTextMorph methodsFor: 'private' stamp: 'cwp 10/30/2004 23:06'! installEditorToReplace: priorEditor "Install an editor for my paragraph. This constitutes 'hasFocus'. If priorEditor is not nil, then initialize the new editor from its state. We may want to rework this so it actually uses the prior editor." | stateArray | priorEditor ifNotNil: [stateArray := priorEditor stateArray]. editor := OBTextMorphEditor new morph: self. editor changeParagraph: self paragraph. priorEditor ifNotNil: [editor stateArrayPut: stateArray]. self selectionChanged. ^ editor! ! OBTextMorph subclass: #OBTextMorphWithShout instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBTextMorphWithShout methodsFor: 'private' stamp: 'tween 3/15/2007 14:08'! editorClass "Answer the class used to create the receiver's editor" ^OBTextMorphEditorWithShout! ! !OBTextMorphWithShout methodsFor: 'private' stamp: 'tween 3/15/2007 14:25'! installEditorToReplace: priorEditor "Install an editor for my paragraph. This constitutes 'hasFocus'. If priorEditor is not nil, then initialize the new editor from its state. We may want to rework this so it actually uses the prior editor." | stateArray | priorEditor ifNotNil: [stateArray := priorEditor stateArray]. editor := self editorClass new morph: self. editor changeParagraph: self paragraph. priorEditor ifNotNil: [editor stateArrayPut: stateArray]. self selectionChanged. ^ editor! ! Object subclass: #OBButtonModel instanceVariableNames: 'bar label' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBButtonModel commentStamp: 'cwp 3/5/2004 12:15' prior: 0! An OBButtonModel serves as a model for PluggableButtonMorphs used OBRadioButtonBar. OBRadioButtonBar cannot be a direct model for its PBMs, since it can contain a variable number of buttons. iVars: bar - the OBRadioButton bar to which this button belongs label - the label of the button! !OBButtonModel class methodsFor: 'as yet unclassified' stamp: 'cwp 8/29/2004 13:31'! offColor ^ Color lightGray twiceLighter! ! !OBButtonModel class methodsFor: 'as yet unclassified' stamp: 'cwp 8/29/2004 13:30'! onColor ^ Color lightGray lighter! ! !OBButtonModel class methodsFor: 'as yet unclassified' stamp: 'cwp 2/24/2004 18:35'! withLabel: aString inBar: aRadioButtonBar ^ self new label: aString; bar: aRadioButtonBar! ! !OBButtonModel methodsFor: 'accessing' stamp: 'cwp 2/24/2004 18:29'! bar: aRadioButtonBar bar := aRadioButtonBar! ! !OBButtonModel methodsFor: 'building' stamp: 'cwp 7/25/2007 23:55'! buildOn: aBuilder ^aBuilder button: self with: []! ! !OBButtonModel methodsFor: 'testing' stamp: 'cwp 11/27/2004 19:09'! isEnabled ^ bar isEnabled: self! ! !OBButtonModel methodsFor: 'callbacks' stamp: 'cwp 2/24/2004 18:42'! isSelected ^ bar isSelected: self! ! !OBButtonModel methodsFor: 'accessing' stamp: 'cwp 3/2/2004 21:46'! label ^ label! ! !OBButtonModel methodsFor: 'accessing' stamp: 'cwp 2/24/2004 18:29'! label: aString label := aString! ! !OBButtonModel methodsFor: 'callbacks' stamp: 'dr 10/21/2008 14:11'! labelMorph | morph | morph := (StringMorph contents: label font: TextStyle defaultFont). (label isText and: [label hasColor]) ifFalse: [morph color: (self isEnabled ifTrue: [Color black] ifFalse: [Color gray])]. ^morph! ! !OBButtonModel methodsFor: 'callbacks' stamp: 'cwp 2/24/2004 19:30'! push bar push: self.! ! !OBButtonModel methodsFor: 'accessing' stamp: 'cwp 11/27/2004 00:50'! selectionChanged self changed: #isSelected. self changed: #labelMorph! ! Object subclass: #OBMorphicIcons instanceVariableNames: '' classVariableNames: 'IconLabels Icons Instance' poolDictionaries: '' category: 'OB-Morphic-Core'! !OBMorphicIcons class methodsFor: 'as yet unclassified' stamp: 'dr 9/4/2008 16:34'! default Instance ifNil: [Instance := self new]. ^Instance! ! !OBMorphicIcons class methodsFor: 'as yet unclassified' stamp: 'dr 9/4/2008 16:35'! iconActionNamed: aSymbol | selector | selector := (aSymbol, 'Action') asSymbol. ^(self default respondsTo: selector) ifTrue: [self default perform: selector] ifFalse: [nil]! ! !OBMorphicIcons class methodsFor: 'configuration' stamp: 'dr 9/4/2008 16:16'! iconHeight ^12! ! !OBMorphicIcons class methodsFor: 'as yet unclassified' stamp: 'dr 9/4/2008 16:35'! iconLabelNamed: aSymbol ^ IconLabels at: aSymbol ifAbsentPut: [self default perform: (aSymbol, 'Label') asSymbol]! ! !OBMorphicIcons class methodsFor: 'as yet unclassified' stamp: 'dr 9/4/2008 16:35'! iconNamed: aSymbol ^ Icons at: aSymbol ifAbsentPut: [self default perform: aSymbol]! ! !OBMorphicIcons class methodsFor: 'configuration' stamp: 'dr 9/4/2008 16:16'! iconWidth ^12! ! !OBMorphicIcons class methodsFor: 'as yet unclassified' stamp: 'dr 9/4/2008 16:33'! initialize Icons := IdentityDictionary new. IconLabels := IdentityDictionary new.! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/25/2008 16:22'! abstractWithOverride ^(Form extent: 10@7 depth: 32 fromArray: #( 16777215 620793087 4177563391 4227894783 4244671999 4261449215 4278226175 4261448959 738233599 16777215 16777215 134253823 4009791999 4278251007 4278255615 4278255615 4278251775 4060123647 184585471 16777215 16777215 16777215 1979748351 4093686783 4278255615 4278255615 4127242495 2181075199 16777215 16777215 16777215 16777215 184585471 4043346431 4278251775 4278252799 4093678079 268471551 16777215 16777215 16777215 16777215 16777215 2130743551 4127241983 4160798463 2399179263 16777215 16777215 16777215 16777215 16777215 16777215 251694335 4093678079 4110455295 369134847 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1879086079 2130744831 16777215 16777215 16777215 16777215) offset: 0@0) ! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/25/2008 10:52'! abstractWithOverrideLabel ^'Abstract method overridden in subclasses'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/11/2008 14:39'! abstractWithoutOverride ^(Form extent: 14@14 depth: 32 fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4283284176 4283284176 4283284176 4283284176 4283284176 4278227627 4278227627 4278227627 4278227627 4278227627 4278227627 4278227627 0 0 4283284176 4294440951 4294440951 4294440951 4294440951 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4278227627 0 0 4283284176 4294440951 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4278227627 0 0 4283284176 4294440951 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4278227627 0 0 4278227627 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4278227627 0 0 4278227627 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4278227627 0 0 4278227627 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4278227627 0 0 4278227627 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4278227627 0 0 4278227627 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4278227627 0 0 4278227627 4283284176 4283284176 4294440951 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4278227627 0 0 4278227627 4283284176 4283284176 4294440951 4294440951 4284075492 4284075492 4284075492 4284075492 4284075492 4284075492 4278227627 0 0 4278227627 4278227627 4278227627 4278227627 4278227627 4278227627 4278227627 4278227627 4278227627 4278227627 4278227627 4278227627 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) offset: 0@0)! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/25/2008 10:52'! abstractWithoutOverrideLabel ^'Abstract method without any overrides'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 8/2/2007 10:27'! arrowDown ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 185273099 185273099 185273099 185273099 185273099 185273099 185273098 168430090 168495883 185273098 151587081 168495883 185273098 151191561 168495883 185207306 151388169 168430091 185207049 151257353 151587339 185272841 328199 151653131 185273098 150997001 168495883 185273099 168364298 185273099 185273099 185207307 185273099 185273099 185273099 185273099) offset: 0@0) colorsFromArray: #(#(0.573 0.804 0.369) #(0.565 0.768 0.412) #(0.577 0.804 0.372) #(0.561 0.804 0.326) #(0.588 0.831 0.345) #(0.6 0.844 0.353) #(0.565 0.804 0.329) #(0.545 0.772 0.349) #(0.486 0.682 0.353) #(0.388 0.561 0.271) #(1.0 1.0 1.0) #( )))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/1/2008 16:00'! arrowDownLabel ^'Method is overridden in subclasses'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 8/2/2007 10:24'! arrowUp ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 185273099 185273099 185273099 185273099 185273099 185273099 185273099 185207307 185273099 185273099 168364298 185273099 185273098 150997001 168495883 185272841 328199 151653131 185207049 151257353 151587339 185207306 151388169 168430091 185273098 151191561 168495883 185273098 151587081 168495883 185273098 168430090 168495883 185273099 185273099 185273099) offset: 0@0) colorsFromArray: #(#(0.573 0.804 0.369) #(0.565 0.768 0.412) #(0.577 0.804 0.372) #(0.561 0.804 0.326) #(0.588 0.831 0.345) #(0.6 0.844 0.353) #(0.565 0.804 0.329) #(0.545 0.772 0.349) #(0.486 0.682 0.353) #(0.388 0.561 0.271) #(1.0 1.0 1.0) #( )))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/1/2008 16:00'! arrowUpLabel ^'Method overrides superclass method'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/1/2008 10:20'! blank ^ Form extent: 14@14 depth: 8! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/1/2008 16:26'! blankLabel ^''! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 6/26/2008 10:47'! breakpoint ^ (Form extent: 10@10 depth: 32 fromArray: #( 1426024004 2650760772 3623839300 4294927940 3623839300 2650760772 1426024004 16737860 16737860 16737860 4294598461 4294736986 4294858806 4294929739 4294869857 4294736986 4293083166 184180541 1174036285 2616876861 4294137396 4294945416 4294923571 4294929996 4294938991 4294945416 4291568128 4294204217 4294541920 4294137396 4293544488 4294945416 4294923571 4294929996 4294938991 4294945416 4293212953 4294934622 4294945416 4293544488 4292951580 4294945416 4294923571 4294929996 4294938991 4294945416 4294068262 4294934622 4294945416 4292951580 4292358672 4293950297 4293081881 4292490258 4293086250 4293950297 4294923571 4294934622 4294945416 4292358672 4291776038 4289679138 684796167 97593607 684796167 4291897607 4293344796 4294604372 4293355076 4291897607 4291598694 4288243251 13378048 13378048 13378048 1691099648 3133940224 4291568128 3133940224 1691099648 4289953869 4288243251 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4288243251 3214501427 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215) offset: 0@0)! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/1/2008 16:01'! breakpointLabel ^'Halt or breakpoint in method'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 6/26/2008 15:36'! exception ^(Form extent: 10@10 depth: 32 fromArray: #( 14526976 16777181 2162010624 4293048097 4293511246 4293842287 4293842287 4293511246 4293048097 3218975232 14263808 16777181 4292453888 4294967261 4294967261 4294967261 4294967261 4294306214 4292453888 14263808 13934848 2161418496 4293577560 4294964656 4294964656 4294964656 4294238340 4292124928 16774576 13934848 13540096 4291730176 4294960495 4294960495 4294960495 4294169171 4292521500 4291730176 4291730176 3217988352 2160563200 4293113111 4294034458 4293771029 4294363681 4294759210 4294827607 4294369147 4291269632 16777215 3217067264 4290809088 4290809088 4290809088 4290809088 4292717056 4293046016 4290809088 16763904 16777215 16763904 16763904 14526976 2159642112 4292651264 4293638144 4290348544 14544639 16763904 16777215 11763712 16763904 16763904 4289953792 4293703936 4289953792 16763904 16763904 16763904 16777215 11434752 11434752 2158918400 4289624832 4289624832 11434752 11434752 11434752 11434752 16777215 11171584 16763904 3215619840 4289361664 11171584 11171584 11171584 11171584 11171584 16777215) offset: 0@0)! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/18/2008 10:59'! exceptionLabel ^'Exception class'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 6/26/2008 15:16'! extended ^(Form extent: 10@10 depth: 32 fromArray: #( 4500036 4500036 4500036 3208948292 4282690116 4282690116 3208948292 4500036 4500036 4500036 4236864 8973960 8973960 4282887495 4287164040 4287164040 4282887495 8973960 8973960 4236864 3907899 8644995 8644995 4283282253 4286835075 4286835075 4283282253 8644995 8644995 3907899 3207961397 4282163772 4282887495 4283545425 4286374524 4286374524 4283545425 4282887495 4282163772 3207961397 4281242670 4287164040 4287164040 4286506110 4285782387 4285782387 4286506110 4287164040 4287164040 4281242670 4280782119 4285190250 4285190250 4285190250 4285190250 4285190250 4285190250 4285190250 4285190250 4280782119 3206579744 4280782119 4281374256 4282032186 4284598113 4284598113 4282032186 4281374256 4280782119 3206579744 1736730 5947482 5947482 4280979498 4284137562 4284137562 4280979498 5947482 5947482 1736730 1407765 5618517 5618517 4280058396 4283808597 4283808597 4280058396 5618517 5618517 1407765 1144593 1144593 1144593 3205592849 4279334673 4279334673 3205592849 1144593 1144593 1144593) offset: 0@0)! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/1/2008 15:58'! extendedLabel ^'Extension method'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'lr 8/2/2007 19:32'! flag ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 437918234 437918234 437918234 436470535 101584139 387389210 436404481 17105924 303634202 436666638 218827016 35198490 437126412 185075720 1644314 437060363 168298504 1644570 436930320 269422351 370743322 437326099 320082453 387520538 437918234 437918234 387520538 454761243 454761242 387520538 454761243 454761242 387520282 454761243 454761242 387389210) offset: 0@0) colorsFromArray: #(#(0.22 0.396 0.585) #(0.898 0.945 0.996) #(0.228 0.498 0.761) #(0.608 0.796 0.98) #(0.635 0.804 0.98) #(0.655 0.819 0.98) #(0.47 0.729 0.973) #(0.542 0.768 0.977) #(0.251 0.631 0.961) #(0.267 0.639 0.961) #(0.275 0.643 0.961) #(0.286 0.647 0.961) #(0.302 0.659 0.965) #(0.326 0.667 0.965) #(0.353 0.678 0.965) #(0.396 0.714 0.965) #(0.419 0.729 0.969) #(0.239 0.686 0.93) #(0.243 0.624 0.772) #(0.236 0.682 0.851) #(0.228 0.667 0.788) #(0.224 0.616 0.671) #(0.384 0.228 0.082) #(0.349 0.212 0.098) #(0.329 0.2 0.094) #(0.694 0.462 0.271) #(1.0 1.0 1.0) #( )))! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/1/2008 15:58'! flagLabel ^'Flag'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/29/2008 10:12'! needsWork ^(Form extent: 10@10 depth: 32 fromArray: #( 1413786180 2638522948 3611601476 4282690116 3611601476 2638522948 1413786180 4500036 4500036 4500036 4282361151 4284269148 4283413839 4284729699 4285124457 4284269148 4280847912 171943231 1161798975 2604639551 4281900600 4287164040 4283808597 4284795492 4286177145 4287164040 4279334673 4282295358 4284663906 4281900600 4281308463 4287164040 4283808597 4284795492 4286177145 4287164040 4281571635 4285518959 4287164040 4281308463 4280716326 4287164040 4283808597 4284795492 4286177145 4287164040 4282690116 4285518959 4287164040 4280716326 4280124189 4284400734 4281111084 4280321568 4281769014 4284400734 4283808597 4285518959 4287164040 4280124189 4283598384 4284968488 672562198 85359638 672562198 4279663638 4281637428 4284861029 4283216460 4279663638 4291598694 4288243251 1144593 1144593 1144593 1678866193 3121706769 4279334673 3121706769 1678866193 4289953869 4288243251 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4288243251 3214501427 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215) offset: 0@0) ! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/1/2008 15:59'! needsWorkLabel ^'Flag inside method'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/1/2008 10:18'! overridden ^(Form extent: 14@14 depth: 32 fromArray: #( 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294952836 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294953611 4294967295 4294967295 4294967295 4294967295 4294960325 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294961616 4294967295 4294967295 4294967295 4294967295 4294967295 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294967295 4294967295 4294967295 4294967295 4294967295 4294901502 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294961358 4294901502 4294967295 4294967295 4294967295 4294967295 4294901502 4294901502 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294901502 4294901502 4294967295 4294967295 4294967295 4294967295 4294835709 4294835709 4294960327 4294935040 4294950656 4294950656 4294935040 4294960844 4294835709 4294835709 4294967295 4294967295 4294967295 4294967295 4294835709 4294835709 4294835709 4294944570 4294939648 4294939648 4294945087 4294835709 4294835709 4294835709 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294960584 4294935040 4294935040 4294960843 4294769916 4294769916 4294769916 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294769916 4294946378 4294946121 4294769916 4294769916 4294769916 4294769916 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4294967295 4294967295) offset: 0@0) ! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/1/2008 10:30'! overriddenAndOverrides ^(Form extent: 14@14 depth: 32 fromArray: #( 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294967295 4294967295 4294901502 4294967295 4294967295 4294967295 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294967295 4294946378 4294946121 4294769916 4294769916 4294769916 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294769916 4294960584 4294935040 4294935040 4294960843 4294769916 4294769916 4294901502 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294835709 4294944570 4294939648 4294939648 4294945087 4294835709 4294835709 4294835709 4294960327 4294935040 4294950656 4294950656 4294935040 4294960327 4294960327 4294935040 4294950656 4294950656 4294935040 4294960844 4294835709 4294835709 4294835709 4294944570 4294939648 4294939648 4294944570 4294901502 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294901502 4294769916 4294769916 4294960584 4294935040 4294935040 4294967295 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294961358 4294769916 4294769916 4294769916 4294946378 4294946121 4294967295 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295) offset: 0@0)! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/1/2008 16:02'! overriddenAndOverridesLabel ^'Method overrides and is overridden'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/1/2008 16:02'! overriddenLabel ^'Method is overridden in subclasses'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/1/2008 10:29'! overrides ^(Form extent: 14@14 depth: 32 fromArray: #( 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294769916 4294946378 4294946121 4294769916 4294769916 4294769916 4294769916 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294960584 4294935040 4294935040 4294960843 4294769916 4294769916 4294769916 4294967295 4294967295 4294967295 4294967295 4294835709 4294835709 4294835709 4294944570 4294939648 4294939648 4294945087 4294835709 4294835709 4294835709 4294967295 4294967295 4294967295 4294967295 4294835709 4294835709 4294960327 4294935040 4294950656 4294950656 4294935040 4294960844 4294835709 4294835709 4294967295 4294967295 4294967295 4294967295 4294901502 4294901502 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294901502 4294901502 4294967295 4294967295 4294967295 4294967295 4294901502 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294961358 4294901502 4294967295 4294967295 4294967295 4294967295 4294967295 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294967295 4294967295 4294967295 4294967295 4294967295 4294960325 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294961616 4294967295 4294967295 4294967295 4294967295 4294952836 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294953611 4294967295 4294967295 4294967295 4294769916 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4294967295 4294967295) offset: 0@0)! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/1/2008 16:01'! overridesLabel ^'Method overrides superclass method'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/11/2008 14:26'! superSendWithOverride ^(Form extent: 14@14 depth: 32 fromArray: #( 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294967295 4294946378 4294946121 4294769916 4294769916 4294769916 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294960584 4294935040 4294935040 4294960843 4294769916 4294769916 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294835709 4294944570 4294939648 4294939648 4294945087 4294835709 4294835709 4294901502 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294960327 4294935040 4294950656 4294950656 4294935040 4294960844 4294835709 4294835709 4294960327 4294935040 4294950656 4294950656 4294935040 4294960327 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294901502 4294835709 4294835709 4294944570 4294939648 4294939648 4294944570 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294961358 4294769916 4294769916 4294960584 4294935040 4294935040 4294960584 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294769916 4294769916 4294769916 4294946378 4294946121 4294967295 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4279543873 4279609153 4278226688 4278243584 4278232320 4278229795 4280002371 4281904980 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294177779 4278232320 4278255360 4278243584 4278234668 4289583541 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4278234681 4278234668 4278234668 4278234668 4289583541 4294967295) offset: 0@0) ! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/29/2008 09:52'! superSendWithOverrideLabel ^'Method sends super and is overridden in subclasses'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/1/2008 10:39'! superSendWithOverrideNoSuperMethod ^(Form extent: 14@14 depth: 32 fromArray: #( 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294967295 4294946378 4294946121 4294769916 4294769916 4294769916 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294960584 4294935040 4294935040 4294960843 4294769916 4294769916 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294835709 4294944570 4294939648 4294939648 4294945087 4294835709 4294835709 4294901502 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294960327 4294935040 4294950656 4294950656 4294935040 4294960844 4294835709 4294835709 4294960327 4294935040 4294950656 4294950656 4294935040 4294960327 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294901502 4294835709 4294835709 4294944570 4294939648 4294939648 4294944570 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294961358 4294769916 4294769916 4294960584 4294935040 4294935040 4294960584 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294769916 4294769916 4294769916 4294946378 4294946121 4294967295 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294967295 4294769916 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4293722138 4293722138 4288610326 4293722138 4293722138 4288610326 4294929001 4294929001 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294177779 4293722138 4294903338 4293722138 4294929001 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4293722138 4293722138 4293722138 4294929001 4294967295 4294967295) offset: 0@0)! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/1/2008 16:16'! superSendWithOverrideNoSuperMethodLabel ^'Method sends super, but superclass method does not exist'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/1/2008 10:42'! superSendWithOverrideOtherSelector ^(Form extent: 14@14 depth: 32 fromArray: #( 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294967295 4294946378 4294946121 4294769916 4294769916 4294769916 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294960584 4294935040 4294935040 4294960843 4294769916 4294769916 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294835709 4294944570 4294939648 4294939648 4294945087 4294835709 4294835709 4294901502 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294960327 4294935040 4294950656 4294950656 4294935040 4294960844 4294835709 4294835709 4294960327 4294935040 4294950656 4294950656 4294935040 4294960327 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294901502 4294835709 4294835709 4294944570 4294939648 4294939648 4294944570 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294961358 4294769916 4294769916 4294960584 4294935040 4294935040 4294960584 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294769916 4294769916 4294769916 4294946378 4294946121 4294967295 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294769916 4294769916 4294769916 4294769916 4294769916 4294769916 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4282400832 4282400832 4278190080 4282400832 4282400832 4278190080 4282400832 4282400832 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294177779 4282400832 4286611584 4282400832 4290822336 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4282400832 4282400832 4282400832 4290822336 4294967295 4294967295) offset: 0@0) ! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/1/2008 16:17'! superSendWithOverrideOtherSelectorLabel ^'Method sends super to a different selector and is overridden in subclasses' ! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/1/2008 10:36'! superSendWithoutOverride ^(Form extent: 14@14 depth: 32 fromArray: #( 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294769916 4294946378 4294946121 4294769916 4294769916 4294769916 4294769916 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294960584 4294935040 4294935040 4294960843 4294769916 4294769916 4294769916 4294967295 4294967295 4294967295 4294967295 4294835709 4294835709 4294835709 4294944570 4294939648 4294939648 4294945087 4294835709 4294835709 4294835709 4294967295 4294967295 4294967295 4294967295 4294835709 4294835709 4294960327 4294935040 4294950656 4294950656 4294935040 4294960844 4294835709 4294835709 4294967295 4294967295 4294967295 4294967295 4294901502 4294901502 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294901502 4294901502 4294967295 4294967295 4294967295 4294967295 4294901502 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294961358 4294901502 4294967295 4294967295 4294967295 4294967295 4294967295 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294967295 4294967295 4294967295 4294967295 4294967295 4294960325 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294961616 4294967295 4294967295 4294967295 4294967295 4294952836 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294953611 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4287351959 4279543873 4279609153 4278226688 4278255360 4278232320 4278229795 4280002371 4281904980 4287220629 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294177779 4278232320 4278255360 4278243584 4287220629 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4278234681 4278234668 4278234668 4289583541 4294967295 4294967295 4294967295 4294967295 4294967295) offset: 0@0) ! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 9/25/2008 10:58'! superSendWithoutOverrideLabel ^'Method sends super'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/11/2008 14:42'! superSendWithoutOverrideNoSuperMethod ^(Form extent: 14@14 depth: 32 fromArray: #( 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294967295 4294946378 4294946121 4294769916 4294769916 4294769916 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294960584 4294935040 4294935040 4294960843 4294769916 4294769916 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294835709 4294944570 4294939648 4294939648 4294945087 4294835709 4294835709 4294901502 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294960327 4294935040 4294950656 4294950656 4294935040 4294960844 4294835709 4294835709 4294960327 4294935040 4294950656 4294950656 4294935040 4294960327 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294901502 4294835709 4294835709 4294944570 4294939648 4294939648 4294944570 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294961358 4294769916 4294769916 4294960584 4294935040 4294935040 4294960584 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294769916 4294769916 4294769916 4294946378 4294946121 4294967295 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294967295 4294769916 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4293722138 4293722138 4288610326 4293722138 4293722138 4288610326 4293722138 4293722138 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294177779 4293722138 4294903338 4293722138 4293722138 4294950846 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4293722138 4293722138 4293722138 4293722138 4294950846 4294967295) offset: 0@0) ! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/1/2008 16:18'! superSendWithoutOverrideNoSuperMethodLabel ^'Method sends super, but superclass method does not exist'! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/11/2008 14:41'! superSendWithoutOverrideOtherSelector ^(Form extent: 14@14 depth: 32 fromArray: #( 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294967295 4294946378 4294946121 4294769916 4294769916 4294769916 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294960584 4294935040 4294935040 4294960843 4294769916 4294769916 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294835709 4294944570 4294939648 4294939648 4294945087 4294835709 4294835709 4294901502 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294960327 4294935040 4294950656 4294950656 4294935040 4294960844 4294835709 4294835709 4294960327 4294935040 4294950656 4294950656 4294935040 4294960327 4294944568 4294939904 4294957312 4294957312 4294939904 4294945601 4294901502 4294835709 4294835709 4294944570 4294939648 4294939648 4294944570 4294960326 4294935040 4294950656 4294957312 4294957312 4294950656 4294935040 4294961358 4294769916 4294769916 4294960584 4294935040 4294935040 4294960584 4294944310 4294939904 4294957312 4294957312 4294957312 4294957312 4294939904 4294945602 4294769916 4294769916 4294769916 4294946378 4294946121 4294967295 4294935040 4294950400 4294956800 4294956800 4294956800 4294956800 4294950400 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294935040 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4294769916 4294769916 4294769916 4294769916 4294769916 4294769916 4294769916 4294769916 4294967295 4294967295 4294967295 4294967295 4294967295 4294769916 4282400832 4282400832 4278190080 4282400832 4282400832 4278190080 4282400832 4282400832 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294177779 4282400832 4286611584 4282400832 4282400832 4292598747 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4282400832 4282400832 4282400832 4282400832 4292598747 4294967295) offset: 0@0)! ! !OBMorphicIcons methodsFor: 'icons' stamp: 'dr 12/1/2008 16:17'! superSendWithoutOverrideOtherSelectorLabel ^'Method sends super to a different selector' ! ! Slider subclass: #OBScrollBar instanceVariableNames: 'upButton downButton pagingArea scrollDelta pageDelta interval menuSelector timeOfMouseDown timeOfLastScroll nextPageDirection currentScrollDelay' classVariableNames: 'CachedImages UpArrow8Bit UpArrow' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBScrollBar commentStamp: 'cwp 3/5/2004 12:01' prior: 0! This class is a relic. It was originally created to work around bugs in ScrollBar which prevented it from working correctly in horizontal orientation. At some point the bugs should be fixed, and ScrollBar should be used instead.! !OBScrollBar class methodsFor: 'as yet unclassified' stamp: 'cwp 11/23/2003 18:07'! alwaysShowFlatScrollbarForAlternativeLook "Set this value to true, if you want to see the flat scrollbar look in flop-out mode as well as inboard. Otherwise the flop-out scrollbar will be rounded and inboard will be flat." ^ false! ! !OBScrollBar class methodsFor: 'class initialization' stamp: 'cwp 11/23/2003 18:07'! initialize "ScrollBar initialize" UpArrow := Form extent: 6@3 fromArray: #(2r11e28 2r1111e27 2r111111e26) offset: 0@0.! ! !OBScrollBar methodsFor: 'accessing' stamp: 'md 2/24/2006 16:12'! adoptPaneColor: aColor "Adopt the given pane color" aColor ifNil:[^self]. self sliderColor: aColor.! ! !OBScrollBar methodsFor: 'geometry' stamp: 'cwp 11/23/2003 18:06'! buttonExtent ^ bounds isWide ifTrue: [11 @ self innerBounds height] ifFalse: [self innerBounds width @ 11]! ! !OBScrollBar methodsFor: 'accessing' stamp: 'cwp 11/23/2003 18:06'! cachedImageAt: aKey ifAbsentPut: aBlock CachedImages ifNil: [CachedImages := Dictionary new]. ^CachedImages at: aKey ifAbsentPut: aBlock! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! doScrollByPage "Scroll automatically while mouse is down" (self waitForDelay1: 300 delay2: 100) ifFalse: [^ self]. nextPageDirection ifTrue: [self setValue: (value + pageDelta min: 1.0)] ifFalse: [self setValue: (value - pageDelta max: 0.0)] ! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! doScrollDown "Scroll automatically while mouse is down" (self waitForDelay1: 200 delay2: 40) ifFalse: [^ self]. self setValue: (value + scrollDelta + 0.000001 min: 1.0)! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! doScrollUp "Scroll automatically while mouse is down" (self waitForDelay1: 200 delay2: 40) ifFalse: [^ self]. self setValue: (value - scrollDelta - 0.000001 max: 0.0)! ! !OBScrollBar methodsFor: 'geometry' stamp: 'cwp 11/23/2003 18:06'! expandSlider "Compute the new size of the slider (use the old sliderThickness as a minimum)." | r | r := self totalSliderArea. slider extent: (bounds isWide ifTrue: [((r width * interval) asInteger max: self sliderThickness) @ slider height] ifFalse: [slider width @ ((r height * interval) asInteger max: self sliderThickness)])! ! !OBScrollBar methodsFor: 'geometry' stamp: 'cwp 11/23/2003 18:06'! extent: p p x > p y ifTrue: [super extent: (p max: 42@8)] ifFalse: [super extent: (p max: 8@42)]! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! finishedScrolling self stopStepping. self scrollBarAction: nil. self roundedScrollbarLook ifTrue:[ upButton borderStyle: (BorderStyle complexRaised width: upButton borderWidth). downButton borderStyle: (BorderStyle complexRaised width: downButton borderWidth). ] ifFalse:[ downButton borderRaised. upButton borderRaised. ]. ! ! !OBScrollBar methodsFor: 'initialization' stamp: 'cwp 11/23/2003 18:07'! initialize super initialize. scrollDelta := 0.02. pageDelta := 0.2. self roundedScrollbarLook ifTrue:[ self borderStyle: ((BorderStyle complexFramed width: 2) "baseColor: Color gray")].! ! !OBScrollBar methodsFor: 'initialize' stamp: 'cwp 11/23/2003 18:06'! initializeDownButton downButton := RectangleMorph newBounds: (self innerBounds bottomRight - self buttonExtent extent: self buttonExtent) color: self thumbColor. downButton on: #mouseDown send: #scrollDownInit to: self. downButton on: #mouseUp send: #finishedScrolling to: self. downButton addMorphCentered: (ImageMorph new image: (self cachedImageAt: (bounds isWide ifTrue: ['right'] ifFalse: ['down']) ifAbsentPut: [ self upArrow8Bit rotateBy: (bounds isWide ifTrue: [#right] ifFalse: [#pi]) centerAt: 0@0 ] ) ). self roundedScrollbarLook ifTrue:[ downButton color: Color veryLightGray. downButton borderStyle: (BorderStyle complexRaised width: 3). ] ifFalse:[ downButton setBorderWidth: 1 borderColor: #raised. ]. self addMorph: downButton. ! ! !OBScrollBar methodsFor: 'initialize' stamp: 'cwp 11/23/2003 18:06'! initializeEmbedded: aBool "aBool == true => inboard scrollbar aBool == false => flop-out scrollbar" self roundedScrollbarLook ifFalse:[^self]. aBool ifTrue:[ self borderStyle: (BorderStyle inset width: 2). self cornerStyle: #square. ] ifFalse:[ self borderStyle: (BorderStyle width: 1 color: Color black). self cornerStyle: #rounded. ]. self removeAllMorphs. self initializeSlider.! ! !OBScrollBar methodsFor: 'initialize' stamp: 'cwp 11/23/2003 18:06'! initializePagingArea pagingArea := RectangleMorph newBounds: self totalSliderArea color: (Color r: 0.6 g: 0.6 b: 0.8). pagingArea borderWidth: 0. pagingArea on: #mouseDown send: #scrollPageInit: to: self. pagingArea on: #mouseUp send: #finishedScrolling to: self. self addMorph: pagingArea. self roundedScrollbarLook ifTrue:[pagingArea color: (Color gray: 0.9)].! ! !OBScrollBar methodsFor: 'initialize' stamp: 'cwp 11/23/2003 18:06'! initializeSlider self roundedScrollbarLook ifTrue:[ self initializeUpButton; initializeDownButton; initializePagingArea. ] ifFalse:[ self initializeUpButton; initializeDownButton; initializePagingArea. ]. super initializeSlider. self roundedScrollbarLook ifTrue:[ slider cornerStyle: #rounded. slider borderStyle: (BorderStyle complexRaised width: 3). sliderShadow cornerStyle: #rounded. ]. self sliderColor: self sliderColor.! ! !OBScrollBar methodsFor: 'initialize' stamp: 'cwp 11/23/2003 18:06'! initializeUpButton upButton := self roundedScrollbarLook ifTrue: [RectangleMorph newBounds: (self innerBounds topLeft extent: self buttonExtent)] ifFalse: [RectangleMorph newBounds: ((self innerBounds topLeft) extent: self buttonExtent)]. upButton color: self thumbColor. upButton on: #mouseDown send: #scrollUpInit to: self. upButton on: #mouseUp send: #finishedScrolling to: self. upButton addMorphCentered: (ImageMorph new image: (self cachedImageAt: (bounds isWide ifTrue: ['left'] ifFalse: ['up']) ifAbsentPut: [bounds isWide ifTrue: [self upArrow8Bit rotateBy: #left centerAt: 0 @ 0] ifFalse: [self upArrow8Bit]])). self roundedScrollbarLook ifTrue: [upButton color: Color veryLightGray. upButton borderStyle: (BorderStyle complexRaised width: 3)] ifFalse: [upButton setBorderWidth: 1 borderColor: #raised]. self addMorph: upButton! ! !OBScrollBar methodsFor: 'access' stamp: 'cwp 11/23/2003 18:06'! interval: d "Supply an optional floating fraction so slider can expand to indicate range" interval := d min: 1.0. self expandSlider. self computeSlider.! ! !OBScrollBar methodsFor: 'other events' stamp: 'cwp 11/23/2003 18:06'! menuButtonMouseDown: event event hand showTemporaryCursor: nil. self use: menuSelector orMakeModelSelectorFor: 'MenuButtonPressed:' in: [:sel | menuSelector := sel. model perform: sel with: event]! ! !OBScrollBar methodsFor: 'other events' stamp: 'cwp 11/23/2003 18:06'! mouseDownInSlider: event interval = 1.0 ifTrue: ["make the entire scrollable area visible if a full scrollbar is clicked on" self setValue: 0. self model hideOrShowScrollBar]. super mouseDownInSlider: event! ! !OBScrollBar methodsFor: 'access' stamp: 'cwp 11/23/2003 18:06'! pagingArea ^pagingArea! ! !OBScrollBar methodsFor: 'scroll timing' stamp: 'cwp 11/23/2003 18:07'! resetTimer timeOfMouseDown := Time millisecondClockValue. timeOfLastScroll := timeOfMouseDown - 1000 max: 0. nextPageDirection := nil. currentScrollDelay := nil! ! !OBScrollBar methodsFor: 'access' stamp: 'md 2/24/2006 21:25'! roundedScrollbarLook "Rounded look currently only shows up in flop-out mode" ^false and: [self class alwaysShowFlatScrollbarForAlternativeLook not] ! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! scrollBarAction ^self valueOfProperty: #scrollBarAction! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! scrollBarAction: aSymbol self setProperty: #scrollBarAction toValue: aSymbol! ! !OBScrollBar methodsFor: 'access' stamp: 'cwp 11/23/2003 18:06'! scrollDelta ^ scrollDelta! ! !OBScrollBar methodsFor: 'access' stamp: 'cwp 11/23/2003 18:06'! scrollDelta: d1 pageDelta: d2 "Supply optional increments for better scrolling of, eg, text" scrollDelta := d1. pageDelta := d2.! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! scrollDown self flag: #obsolete. downButton eventHandler: nil. downButton on: #mouseDown send: #scrollDownInit to: self. downButton on: #mouseUp send: #finishedScrolling to: self. ^self scrollDownInit! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! scrollDown: count self setValue: (value + (scrollDelta * count) + 0.000001 min: 1.0)! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! scrollDownInit downButton borderInset. self resetTimer. self scrollBarAction: #doScrollDown. self startStepping.! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! scrollPageInit: evt self resetTimer. self setNextDirectionFromEvent: evt. self scrollBarAction: #doScrollByPage. self startStepping.! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! scrollUp self flag: #obsolete. upButton eventHandler: nil. upButton on: #mouseDown send: #scrollUpInit to: self. upButton on: #mouseUp send: #finishedScrolling to: self. ^self scrollUpInit! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! scrollUp: count self setValue: (value - (scrollDelta * count) - 0.000001 max: 0.0)! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! scrollUpInit upButton borderInset. self resetTimer. self scrollBarAction: #doScrollUp. self startStepping.! ! !OBScrollBar methodsFor: 'scrolling' stamp: 'cwp 11/23/2003 18:06'! setNextDirectionFromEvent: event nextPageDirection := bounds isWide ifTrue: [ event cursorPoint x >= slider center x ] ifFalse: [ event cursorPoint y >= slider center y ] ! ! !OBScrollBar methodsFor: 'model access' stamp: 'cwp 11/23/2003 18:06'! setValue: newValue "Using roundTo: instead of truncateTo: ensures that scrollUp will scroll the same distance as scrollDown." ^ super setValue: (newValue roundTo: scrollDelta)! ! !OBScrollBar methodsFor: 'access' stamp: 'md 2/24/2006 16:26'! sliderColor: aColor "Change the color of the scrollbar to go with aColor." | buttonColor | super sliderColor: aColor. buttonColor := self thumbColor. upButton color: buttonColor. downButton color: buttonColor. slider color: buttonColor. self roundedScrollbarLook ifTrue: [self color: Color transparent. pagingArea color: aColor muchLighter. self borderStyle style == #simple ifTrue:[self borderColor: aColor darker darker] ifFalse:[self borderStyle baseColor: aColor]] ifFalse: [pagingArea color: (aColor alphaMixed: 0.3 with: Color white). self borderWidth: 0] ! ! !OBScrollBar methodsFor: 'geometry' stamp: 'cwp 11/23/2003 18:06'! sliderExtent "The sliderExtent is now stored in the slider itself, not hardcoded as it is in the superclass." ^slider extent! ! !OBScrollBar methodsFor: 'access' stamp: 'cwp 11/23/2003 18:06'! sliderShadowColor ^ self roundedScrollbarLook ifTrue: [self sliderColor darker] ifFalse: [super sliderShadowColor] ! ! !OBScrollBar methodsFor: 'geometry' stamp: 'cwp 11/23/2003 18:07'! sliderThickness ^ self roundedScrollbarLook ifTrue:[15] ifFalse:[super sliderThickness]! ! !OBScrollBar methodsFor: 'stepping and presenter' stamp: 'cwp 11/23/2003 18:07'! step | action | action := self scrollBarAction. action ifNotNil:[self perform: action].! ! !OBScrollBar methodsFor: 'testing' stamp: 'cwp 11/23/2003 18:06'! stepTime ^ currentScrollDelay ifNil: [300]! ! !OBScrollBar methodsFor: 'access' stamp: 'md 2/24/2006 16:27'! thumbColor "Problem: Part of the ScrollBar/Slider code uses 'slider' to mean the entire scrollbar/slider widget, and part of it uses 'slider' to mean only the draggable 'thumb'. This should be cleaned up so that 'thumb' is used instead of 'slider' where appropriate. For now, the meaning of thumbColor is clear, at least." ^self sliderColor alphaMixed: 0.7 with: (Color gray: 0.95).! ! !OBScrollBar methodsFor: 'geometry' stamp: 'cwp 11/23/2003 18:07'! totalSliderArea | upperBoundsButton | upperBoundsButton := upButton. upButton bottom > upperBoundsButton bottom ifTrue: [upperBoundsButton := upButton]. ^ bounds isWide ifTrue: [upperBoundsButton bounds topRight corner: downButton bounds bottomLeft] ifFalse: [upperBoundsButton bounds bottomLeft corner: downButton bounds topRight]. ! ! !OBScrollBar methodsFor: 'initialize' stamp: 'cwp 11/23/2003 18:06'! upArrow8Bit "convert to 8-bit and convert white to transparent to avoid gratuitous conversion every time we put one in an ImageMorph" ^UpArrow8Bit ifNil: [ UpArrow8Bit := (ColorForm mappingWhiteToTransparentFrom: UpArrow) asFormOfDepth: 8 ]! ! !OBScrollBar methodsFor: 'scroll timing' stamp: 'cwp 11/23/2003 18:07'! waitForDelay1: delay1 delay2: delay2 "Return true if an appropriate delay has passed since the last scroll operation. The delay decreases exponentially from delay1 to delay2." | now scrollDelay | timeOfLastScroll isNil ifTrue: [self resetTimer]. "Only needed for old instances" now := Time millisecondClockValue. (scrollDelay := currentScrollDelay) isNil ifTrue: [scrollDelay := delay1 "initial delay"]. currentScrollDelay := scrollDelay * 9 // 10 max: delay2. "decrease the delay" timeOfLastScroll := now. ^true! ! !OBScrollBar methodsFor: 'testing' stamp: 'cwp 11/23/2003 18:06'! wantsSteps ^self scrollBarAction notNil! ! !OBClassNode methodsFor: '*ob-morphic' stamp: 'dr 8/21/2008 15:13'! shouldBeStyledBy: aShoutMorph super shouldBeStyledBy: aShoutMorph. ^true! ! !BorderedSubpaneDividerMorph methodsFor: '*ob-morphic' stamp: 'cwp 7/23/2007 02:09'! styleWith: aBuilder self vResizing = #spaceFill ifTrue: [aBuilder styleVerticalDivider: self] ifFalse: [aBuilder styleHorizontalDivider: self]! ! !OBMethodNode methodsFor: '*ob-morphic' stamp: 'dr 8/21/2008 15:13'! shouldBeStyledBy: aShoutMorph super shouldBeStyledBy: aShoutMorph. (self theClass isBehavior or: [self theClass isTrait]) ifTrue: [aShoutMorph classOrMetaClass: self theClass]. ^true! ! PluggableListMorph subclass: #OBPluggableListMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! !OBPluggableListMorph commentStamp: 'dr 7/18/2007 14:27' prior: 0! I am a special kind of PluggableListMorph and provides methods to access icons for list elements. I use OBLazyListMorph as listMorphClass! !OBPluggableListMorph methodsFor: 'model access' stamp: 'dr 10/31/2008 16:08'! backgroundColorAt: anInteger ^model backgroundColorAt: anInteger! ! !OBPluggableListMorph methodsFor: 'model access' stamp: 'cwp 7/24/2007 00:12'! iconAt: index ^ model iconAt: index! ! !OBPluggableListMorph methodsFor: 'list management' stamp: 'dr 12/2/2008 15:40'! listMorph listMorph ifNil: [ "crate this lazily, in case the morph is legacy" listMorph := self listMorphClass new. listMorph listSource: self. listMorph adjustHeight. listMorph width: self scroller width. listMorph color: self textColor ]. listMorph owner ~~ self scroller ifTrue: [ "list morph needs to be installed. Again, it's done this way to accomodate legacy PluggableListMorphs" self scroller removeAllMorphs. self scroller addMorph: listMorph ]. ^listMorph! ! !OBPluggableListMorph methodsFor: 'list management' stamp: 'dr 4/24/2007 16:39'! listMorphClass ^OBLazyListMorph! ! !OBPluggableListMorph methodsFor: 'as yet unclassified' stamp: 'cwp 7/5/2007 23:31'! mouseUp: event "Override a change in PLM that breaks OmniBrowser. This version of the method is from Squeak 3.7 and was originally stamped: 'ls 6/22/2001 22:49'" | row | row := self rowAtLocation: event position. "aMorph ifNotNil: [aMorph highlightForMouseDown: false]." model okToChange ifFalse: [^ self]. (autoDeselect == false and: [row == 0]) ifTrue: [^ self]. "work-around the no-mans-land bug" "No change if model is locked" ((autoDeselect == nil or: [autoDeselect]) and: [row == self selectionIndex]) ifTrue: [self changeModelSelection: 0] ifFalse: [self changeModelSelection: row]. Cursor normal show. ! ! OBBuilder subclass: #OBMorphBuilder instanceVariableNames: 'color' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Core'! !OBMorphBuilder class methodsFor: 'instance-creation' stamp: 'lr 6/20/2007 09:36'! open: aModel ^ (self build: aModel) openInWorld! ! !OBMorphBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:55'! button: aButtonModel with: aBlock | morph | morph := PluggableButtonMorph on: aButtonModel getState: #isSelected action: #push label: #labelMorph. morph hResizing: #spaceFill; vResizing: #spaceFill; styleWith: OBMorphBuilder new. ^self current: morph do: aBlock! ! !OBMorphBuilder methodsFor: 'building' stamp: 'MAD 1/14/2009 13:52'! fixedButtonBar: aPanel with: aBlock | morph | morph := OBButtonBar on: aPanel. morph height: Preferences standardButtonFont height * 2.2; layoutPolicy: TableLayout new; vResizing: #rigid; hResizing: #spaceFill; listDirection: #leftToRight; rubberBandCells: true; borderWidth: 0. current addMorphBack: morph. self current: morph do: aBlock! ! !OBMorphBuilder methodsFor: 'building' stamp: 'cwp 12/9/2007 11:58'! horizontalGroupWith: aBlock | morph | morph := OBGroupingMorph new. morph layoutPolicy: TableLayout new. morph listDirection: #leftToRight. current addMorph: morph frame: (0 @ 0 extent: 1 @ 1). self current: morph do: aBlock. morph addBorders! ! !OBMorphBuilder methodsFor: 'private' stamp: 'cwp 12/17/2007 23:40'! layoutPanels | panes | panes := current submorphs select: [:ea | ea class == OBGroupingMorph]. (self shouldUseSpecialLayoutFor: panes) ifTrue: [panes first layoutFrame bottomFraction: 0.4. panes second layoutFrame topFraction: 0.4] ifFalse: [panes withIndexDo: [:morph :index | morph layoutFrame topFraction: index - 1 / panes size; bottomFraction: index / panes size]]. panes do: [:ea | ea on: #mouseEnter send: #paneTransition: to: current. ea on: #mouseLeave send: #paneTransition: to: current]. self style39 ifTrue: [current addPaneSplitters]! ! !OBMorphBuilder methodsFor: 'private' stamp: 'cwp 7/5/2007 23:31'! listMorphForColumn: aColumn ^ (OBPluggableListMorph on: aColumn list: #list selected: #selection changeSelected: #selection: menu: #menu: keystroke: #keystroke:from:) getListElementSelector: #listAt:; getListSizeSelector: #listSize; dragEnabled: aColumn dragEnabled; dropEnabled: aColumn dropEnabled; borderWidth: 0; autoDeselect: false; yourself! ! !OBMorphBuilder methodsFor: 'private' stamp: 'dr 10/30/2008 16:22'! mercuryMorphFor: aMercuryPanel ^ (OBPluggableTextMorph on: aMercuryPanel text: #text accept: #accept:notifying: readSelection: #selection menu: #menu:shifted:) font: Preferences standardCodeFont; hideScrollBarsIndefinitely; acceptOnCR: true; height: Preferences standardCodeFont height * 1.2; borderWidth: 0; vResizing: #rigid; hResizing: #spaceFill; yourself.! ! !OBMorphBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:47'! pane: aColumn with: aBlock | pane | pane := OBPane new. pane model: aColumn; hResizing: #spaceFill; vResizing: #spaceFill; clipSubmorphs: true; color: Color transparent; cellInset: 0; borderWidth: 0; layoutPolicy: ProportionalLayout new; addList: (self listMorphForColumn: aColumn). current ifNotNil: [current pushPane: pane]. ^self current: pane do: aBlock! ! !OBMorphBuilder methodsFor: 'building' stamp: 'dr 10/21/2008 14:15'! radioButtonBar: aSwitch with: aBlock | morph buttonBarClass | buttonBarClass := (aSwitch filter class = OBModalFilter and: [Smalltalk hasClassNamed: #OBEnhancementRadioButtonBar]) ifTrue: [Smalltalk at: #OBEnhancementRadioButtonBar] ifFalse: [OBRadioButtonBar]. ^aSwitch isActive ifTrue: [morph := buttonBarClass on: aSwitch list: #list selected: #selection changeSelected: #selection:. current ifNotNil: [current addButton: morph]. morph]! ! !OBMorphBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:46'! scroller: aColumnPanel with: aBlock | morph | morph := (OBPaneScroller withModel: aColumnPanel) name: 'scroller'; vResizing: #spaceFill; hResizing: #spaceFill; yourself. current ifNotNil: [current addMorphBack: morph]. ^self current: morph do: aBlock! ! !OBMorphBuilder methodsFor: 'private' stamp: 'cwp 12/17/2007 23:53'! shouldUseSpecialLayoutFor: panes ^ panes size = 2 and: [panes first listDirection = #topToBottom] and: [panes second listDirection = #topToBottom] and: [panes first lastSubmorph class = OBPaneScroller] and: [panes last lastSubmorph class = OBPluggableTextMorph]! ! !OBMorphBuilder methodsFor: 'style' stamp: 'cwp 7/23/2007 02:04'! style39 ^ Smalltalk hasClassNamed: #AbstractResizerMorph! ! !OBMorphBuilder methodsFor: 'style' stamp: 'cwp 7/21/2007 22:26'! styleButton: aButton self style39 ifFalse: [aButton borderWidth: 2; borderRaised]! ! !OBMorphBuilder methodsFor: 'style' stamp: 'cwp 7/21/2007 22:26'! styleButtonBar: aBar self style39 ifFalse: [aBar borderWidth: 0] ifTrue: [aBar color: Color transparent; borderWidth: 0; layoutInset: 2; cellInset: 2] ! ! !OBMorphBuilder methodsFor: 'style' stamp: 'cwp 7/23/2007 02:08'! styleHorizontalDivider: divider self style39 ifTrue: [divider height: 3] ifFalse: [divider borderWidth: 2; borderInset]! ! !OBMorphBuilder methodsFor: 'style' stamp: 'cwp 7/23/2007 02:08'! styleVerticalDivider: divider self style39 ifTrue: [divider height: 3] ifFalse: [divider borderWidth: 2; borderRaised]! ! !OBMorphBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:48'! textarea: aDefinitionPanel with: aBlock "see CodeHolder>>buildMorphicCodePaneWith:" | morph shoutInstalled morphClass | shoutInstalled := (Smalltalk classNamed: #SHTextStylerST80) notNil. morphClass := shoutInstalled ifTrue: [OBPluggableTextMorphWithShout] ifFalse: [OBPluggableTextMorph]. morph := morphClass on: aDefinitionPanel text: #text accept: #accept:notifying: readSelection: #selection menu: #menu:shifted:. morph font: Preferences standardCodeFont; borderWidth: 0; vResizing: #spaceFill; hResizing: #spaceFill. current ifNotNil: [current addMorphBack: morph]. ^self current: morph do: aBlock! ! !OBMorphBuilder methodsFor: 'building' stamp: 'cwp 7/25/2007 23:57'! textfield: aMercuryPanel with: aBlock | morph divider | morph := self mercuryMorphFor: aMercuryPanel. morph color: Color white. current ifNotNil: [current addMorphBack: morph. self current: morph do: aBlock. divider := (BorderedSubpaneDividerMorph horizontal) color: aMercuryPanel browser defaultBackgroundColor duller; styleWith: OBMorphBuilder new. current addMorphBack: divider]. ^morph! ! !OBMorphBuilder methodsFor: 'building' stamp: 'cwp 12/9/2007 10:57'! verticalGroupWith: aBlock | morph | morph := OBGroupingMorph new. morph layoutPolicy: TableLayout new. current addMorph: morph frame: (0 @ 0 extent: 1 @ 1). self current: morph do: aBlock! ! !OBMorphBuilder methodsFor: 'building' stamp: 'dr 4/11/2008 11:47'! window: aBrowser with: aBlock | window | color := aBrowser defaultBackgroundColor. window := SystemWindow labelled: aBrowser labelString. window model: aBrowser. ^self current: window do: [aBlock value. self layoutPanels]! ! !OBNode methodsFor: '*ob-morphic' stamp: 'cwp 3/2/2004 21:28'! acceptDroppedNode: aNode ^ aNode perform: self dropSelector with: self ! ! !OBNode methodsFor: '*ob-morphic' stamp: 'avi 2/20/2004 14:00'! asDraggableMorph ^(StringMorph contents: self name) color: Color white; yourself! ! !OBNode methodsFor: '*ob-morphic' stamp: 'cwp 3/2/2004 21:29'! dropSelector "Override in subclasses" ^ #dropOnNode: ! ! !OBNode methodsFor: '*ob-morphic' stamp: 'dc 9/4/2008 17:40'! shouldBeStyledBy: aShoutMorph aShoutMorph classOrMetaClass: nil. ^false! ! !OBNode methodsFor: '*ob-morphic' stamp: 'cwp 3/2/2004 21:28'! wantsDroppedNode: aNode ^ aNode respondsTo: self dropSelector! ! !OBClassCategoryNode methodsFor: '*ob-morphic' stamp: 'dr 8/21/2008 15:14'! shouldBeStyledBy: aShoutMorph super shouldBeStyledBy: aShoutMorph. ^true! ! !OBMethodVersionNode methodsFor: '*ob-morphic' stamp: 'dr 12/16/2008 11:20'! shouldBeStyledBy: aShoutMorph aShoutMorph classOrMetaClass: nil. ^false! ! LazyListMorph subclass: #OBLazyListMorph instanceVariableNames: 'handPoint balloonShown' classVariableNames: '' poolDictionaries: '' category: 'OB-Morphic-Morphs'! OBLazyListMorph class instanceVariableNames: 'handPoint'! !OBLazyListMorph commentStamp: 'dr 7/18/2007 14:28' prior: 0! I am an adapted version of LazyListMorph. I can display icons and colors for my elements.! OBLazyListMorph class instanceVariableNames: 'handPoint'! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 12/2/2008 15:40'! adjustHeight self height: (listItems size max: 1) * (listSource ifNotNilDo: [:src | src listItemHeight] ifNil: [font height]) ! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 9/1/2008 17:16'! balloonText ^'activate'! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 9/2/2008 11:00'! boundsForBalloon ^handPoint ifNotNil: [Rectangle origin: (handPoint x + 3) @ (handPoint y - 3) extent: 1@1] ifNil: [Rectangle origin: 1@1 extent: 1@1]! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 12/9/2008 20:22'! colorForRow: row | item | ^(selectedRow notNil and: [ row = selectedRow]) ifTrue: [ (listSource backgroundColorAt: row) ifNotNilDo: [:clr | clr alphaMixed: 0.1 with: Color blue] ifNil: [Color red] ] ifFalse: [ item := self getListItem: row. item isText ifTrue: [item colorAt: 1] ifFalse: [self color] ].! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 10/31/2008 16:15'! display: item atRow: row on: canvas "display the given item at row row" | drawBounds top icon | drawBounds := self drawBoundsForRow: row. drawBounds := drawBounds intersect: self bounds. (listSource backgroundColorAt: row) ifNotNilDo: [:aColor | canvas fillRectangle: drawBounds color: aColor]. (listSource iconAt: row) ifNotNilDo: [:name | icon := OBMorphicIcons iconNamed: name. top := drawBounds top + (drawBounds height - icon height // 2). canvas translucentImage: icon at: drawBounds left @ top. drawBounds := drawBounds left: drawBounds left + icon width + 2]. item isText ifTrue: [canvas drawString: item in: drawBounds font: (font emphasized: (item emphasisAt: 1)) color: (self colorForRow: row) ] ifFalse: [canvas drawString: item in: drawBounds font: font color: (self colorForRow: row) ].! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 12/2/2008 11:02'! drawBoundsForRow: row "calculate the bounds that row should be drawn at. This might be outside our bounds!!" | topLeft drawBounds | topLeft := self topLeft x @ (self topLeft y + ((row - 1) * (listSource listItemHeight))). drawBounds := topLeft extent: self width @ listSource listItemHeight . ^drawBounds! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 10/18/2008 20:39'! handleMouseDown: anEvent | eventPosition row | "super handleMouseDown: anEvent." anEvent wasHandled ifTrue: [^self]. "position := self positionInWorld. " eventPosition := anEvent position. row := self rowAtLocation: eventPosition x @ eventPosition y. (row >= 1 and: [eventPosition x < OBMorphicIcons iconWidth]) ifTrue: [ eventPosition x < OBMorphicIcons iconWidth ifTrue: [ (listSource iconAt: row) ifNotNilDo: [:name | anEvent wasHandled: true. (OBMorphicIcons iconActionNamed: name) ifNotNilDo: [:action | listSource model okToChange ifTrue: [ action value: (listSource nodeAt: row) value: listSource model]]. ] ] ]. " iconArea := self boundsForBalloon. newOrigin := (iconArea origin x - self positionInWorld x - 6) @ (iconArea origin y + self positionInWorld y abs). iconArea setOrigin: newOrigin corner: (newOrigin x + 12) @ (newOrigin y + 12). (iconArea containsPoint: eventPosition) ifFalse: [ anEvent hand removePendingBalloonFor: self. anEvent hand triggerBalloonFor: self after: (2 * self balloonHelpDelayTime). balloonShown := false]."! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 9/2/2008 14:44'! handleMouseMove: anEvent | iconArea newOrigin eventPosition | super handleMouseMove: anEvent. eventPosition := anEvent position. anEvent wasHandled ifTrue: [^self]. handPoint ifNil: [^self]. (balloonShown notNil and: [balloonShown == false]) ifTrue: [^self]. iconArea := self boundsForBalloon. newOrigin := (iconArea origin x - self positionInWorld x - 6) @ (iconArea origin y + self positionInWorld y abs). iconArea setOrigin: newOrigin corner: (newOrigin x + 12) @ (newOrigin y + 12). (iconArea containsPoint: eventPosition) ifFalse: [ anEvent hand removePendingBalloonFor: self. anEvent hand triggerBalloonFor: self after: (2 * self balloonHelpDelayTime). balloonShown := false].! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 9/4/2008 16:10'! handlesMouseDown: anEvent ^true! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 9/1/2008 11:59'! handlesMouseOver: anEvent ^true! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 12/2/2008 11:04'! rectForRow: index "return a rectangle containing the row at index" | top | top := self top + (index - 1 * listSource listItemHeight). ^ (self left @ top) extent: self width @ listSource listItemHeight ! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 12/2/2008 11:05'! rowAtLocation: aPoint "return the number of the row at aPoint" | y | y := aPoint y. y < self top ifTrue: [ ^ 1 ]. ^((y - self top // (listSource listItemHeight)) + 1) min: listItems size max: 0! ! !OBLazyListMorph methodsFor: 'drawing' stamp: 'dr 9/2/2008 14:45'! showBalloon: msgString hand: aHand "find element at hand to determine icon and finally tooltip" | row position | handPoint := aHand cursorPoint. position := self positionInWorld. row := self rowAtLocation: aHand cursorPoint x @ (handPoint y - position y). (handPoint x - self positionInWorld x) < 20 ifTrue: [ (listSource iconAt: row) ifNotNilDo: [:name | | label | label := (OBMorphicIcons iconLabelNamed: name). label ifNotEmpty: [balloonShown := true. super showBalloon: label hand: aHand. aHand triggerBalloonFor: self after: self balloonHelpDelayTime]]. ].! ! !MenuMorph methodsFor: '*ob-morphic' stamp: 'cwp 6/8/2007 20:45'! add: label target: anObject selector: aSelector enabled: aBoolean icon: aSymbol self add: label target: anObject selector: aSelector. self lastItem isEnabled: aBoolean. Preferences menuWithIcons ifTrue: [self lastItem icon: (self iconNamed: aSymbol)]! ! !MenuMorph methodsFor: '*ob-morphic' stamp: 'cwp 9/30/2007 18:34'! addSubmenu: aString enabled: aBoolean "Append the given submenu with the given label." | item submenu | item := MenuItemMorph new. submenu := MenuMorph new. item contents: aString; isEnabled: aBoolean; subMenu: submenu. self addMorphBack: item. ^ submenu! ! !MenuMorph methodsFor: '*ob-morphic' stamp: 'cwp 6/8/2007 20:41'! iconNamed: aSymbol | sel | aSymbol ifNil: [^ MenuIcons blankIcon]. sel := (MenuIcons respondsTo: aSymbol) ifTrue: [aSymbol] ifFalse: [('small', aSymbol capitalized) asSymbol]. ^ MenuIcons perform: sel! ! !OBMethodCategoryNode methodsFor: '*ob-morphic' stamp: 'dr 8/21/2008 15:13'! shouldBeStyledBy: aShoutMorph super shouldBeStyledBy: aShoutMorph. (self theClass isBehavior or: [self theClass isTrait]) ifTrue: [aShoutMorph classOrMetaClass: self theClass]. ^true! ! !PluggableButtonMorph methodsFor: '*ob-morphic' stamp: 'cwp 7/21/2007 21:18'! styleWith: aBuilder aBuilder styleButton: self! ! !OBDefinitionPanel methodsFor: '*ob-morphic' stamp: 'dc 8/24/2007 12:34'! addItem: classAndMethod "Used by the system when the user clicks on a link in a class comment. For example see class comment of SystemProgressMorph and click on displayProgressAt:from:to:during:." |tokens class methodNode| tokens := classAndMethod findTokens: Character space. tokens size ~= 2 ifTrue: [^ self]. class := Smalltalk classNamed: tokens first. class ifNil: [^ self]. methodNode := OBMethodNode on: tokens second inClass: class. methodNode browse! ! !OBDefinitionPanel methodsFor: '*ob-morphic' stamp: 'dr 8/21/2008 15:18'! shoutAboutToStyle: aPluggableShoutMorph ^browser currentNode ifNotNilDo: [:node | node shouldBeStyledBy: aPluggableShoutMorph] ifNil: [false] ! ! OBMorphicIcons initialize! OBScrollBar initialize!