'From Squeak3.11alpha of 13 February 2010 [latest update: #9483] on 9 March 2010 at 11:11:23 am'! AbstractResizerMorph subclass: #CornerGripMorph instanceVariableNames: 'target ' classVariableNames: 'PassiveForm ActiveForm ' poolDictionaries: '' category: 'Morphic-Windows'! !CornerGripMorph commentStamp: 'jmv 1/29/2006 17:15' prior: 0! I am the superclass of a hierarchy of morph specialized in allowing the user to resize windows.! CornerGripMorph class instanceVariableNames: 'ActiveForm PassiveForm '! AlignmentMorph subclass: #DockingBarMorph instanceVariableNames: 'originalColor gradientRamp fillsOwner avoidVisibleBordersAtEdge autoGradient selectedItem activeSubMenu oldKeyboardFocus oldMouseFocus' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Menus-DockingBar'! MenuItemMorph subclass: #DockingBarItemMorph instanceVariableNames: 'selectedIcon' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Menus-DockingBar'! AlignmentMorph subclass: #MenuMorph instanceVariableNames: 'defaultTarget selectedItem stayUp popUpOwner activeSubMenu activatorDockingBar ' classVariableNames: 'CloseBoxImage PushPinImage ' poolDictionaries: '' category: 'Morphic-Menus'! !MenuMorph commentStamp: '' prior: 0! Instance variables: defaultTarget The default target for creating menu items selectedItem The currently selected item in the receiver stayUp True if the receiver should stay up after clicks popUpOwner The menu item that automatically invoked the receiver, if any. activeSubMenu The currently active submenu.! MenuMorph subclass: #DockingBarMenuMorph instanceVariableNames: 'activatorDockingBar' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Menus-DockingBar'! DockingBarMenuMorph subclass: #DockingBarUpdatingMenuMorph instanceVariableNames: 'arguments updater updateSelector menuUpdater' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Menus-DockingBar'! Object subclass: #MenuUpdater instanceVariableNames: 'updater updateSelector arguments' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Menus'! MenuMorph subclass: #UpdatingMenuMorph instanceVariableNames: 'updater updateSelector arguments menuUpdater ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Menus'! !CornerGripMorph class methodsFor: 'handle settings' stamp: 'HenrikSperreJohansen 2/25/2010 01:28'! activeColor ^(self activeForm colorAt: 24@24) alpha: 1! ! !CornerGripMorph class methodsFor: 'handle settings' stamp: 'HenrikSperreJohansen 2/25/2010 01:41'! activeColor: aColor |canvas| canvas := self initializeActiveForm getCanvas. canvas privatePort fillPattern: aColor; combinationRule: Form rgbMul; fillRect: (self activeForm boundingBox) offset: 0@0. ! ! !CornerGripMorph class methodsFor: 'handle settings' stamp: 'HenrikSperreJohansen 2/25/2010 01:28'! passiveColor ^(self passiveForm colorAt: 24@24) alpha: 1! ! !CornerGripMorph class methodsFor: 'handle settings' stamp: 'HenrikSperreJohansen 2/25/2010 01:53'! passiveColor: aColor | canvas | canvas := self initializePassiveForm getCanvas. canvas privatePort fillPattern: aColor; combinationRule: Form rgbMul; fillRect: self passiveForm boundingBox offset: 0 @ 0. self allSubInstancesDo: [:each | each setDefaultColors; changed]! ! !CornerGripMorph class methodsFor: 'class initialization' stamp: 'HenrikSperreJohansen 2/25/2010 02:23'! initialize "CornerGripMorph initialize" super initialize. self initializeActiveForm. self initializePassiveForm. self activeColor: Color orange.! ! !DockingBarMorph methodsFor: 'events' stamp: 'kb 2/22/2010 15:09'! activate: evt "Receiver should be activated; e.g., so that control passes correctly." oldKeyboardFocus := evt hand keyboardFocus. self oldMouseFocus: evt hand mouseFocus. evt hand newKeyboardFocus: self; newMouseFocus: self. self ensureSelectedItem: evt! ! !DockingBarMorph methodsFor: 'events' stamp: 'kb 2/4/2010 14:42'! deactivate: evt self selectItem: nil event: evt. evt hand newKeyboardFocus: self oldKeyboardFocus; newMouseFocus: self oldMouseFocus! ! !DockingBarMorph methodsFor: 'events' stamp: 'kb 2/22/2010 15:09'! ensureSelectedItem: evt self selectedItem ifNil: [ self selectItem: ( self submorphs detect: [ :each | each isKindOf: DockingBarItemMorph ] ifNone: [ ^self ]) event: evt ]! ! !DockingBarMorph methodsFor: 'events' stamp: 'kb 2/4/2010 12:48'! oldKeyboardFocus oldKeyboardFocus = self ifTrue: [ ^nil ] ifFalse: [ ^oldKeyboardFocus ]! ! !DockingBarMorph methodsFor: 'events' stamp: 'kb 2/4/2010 12:48'! oldMouseFocus oldMouseFocus = self ifTrue: [ ^nil ] ifFalse: [ ^oldMouseFocus ]! ! !DockingBarMorph methodsFor: 'events' stamp: 'kb 2/4/2010 14:49'! oldMouseFocus: aMorph (self submorphs includes: aMorph) ifFalse: [ oldMouseFocus := aMorph ] ifTrue: [ oldMouseFocus := nil ] ! ! !DockingBarMorph methodsFor: 'control' stamp: 'kb 2/4/2010 14:20'! activeSubmenu: aSubmenu activeSubMenu isNil ifFalse: [activeSubMenu delete]. activeSubMenu := aSubmenu. aSubmenu isNil ifTrue: [^ self]. activeSubMenu updateMenu. activeSubMenu selectItem: nil event: nil. MenuIcons decorateMenu: activeSubMenu. activeSubMenu activatedFromDockingBar: self; borderColor: self borderColor; beSticky; resistsRemoval: true; removeMatchString! ! !DockingBarMorph methodsFor: 'control' stamp: 'kb 2/22/2010 15:54'! deleteIfPopUp: evt evt ifNotNil: [ evt hand releaseMouseFocus: self ]! ! !DockingBarMorph methodsFor: 'control' stamp: 'kb 2/4/2010 11:37'! moveSelectionDown: direction event: evt "Move the current selection up or down by one, presumably under keyboard control. direction = +/-1" | index | index := (submorphs indexOf: selectedItem ifAbsent: [1-direction]) + direction. submorphs do: "Ensure finite" [:unused | | m | m := submorphs atWrap: index. ((m isKindOf: DockingBarItemMorph) and: [m isEnabled]) ifTrue: [^ self selectItem: m event: evt]. "Keep looking for an enabled item" index := index + direction sign]. ^ self selectItem: nil event: evt! ! !DockingBarMorph methodsFor: 'submorphs-add/remove' stamp: 'kb 2/22/2010 10:42'! delete ActiveHand removeKeyboardListener: self. activeSubMenu ifNotNil: [activeSubMenu delete]. ^ super delete! ! !DockingBarMorph methodsFor: 'events-processing' stamp: 'kb 2/26/2010 13:07'! handleListenEvent: anEvent " I am registered as a keyboardListener of the ActiveHand, watching for ctrl- keystrokes, and upon them if I have an nth menu item, I'll activate myself and select it. " (anEvent controlKeyPressed and: [ anEvent keyValue between: 49 " $1 asciiValue " and: 57 " $9 asciiValue " ]) ifTrue: [ | index itemToSelect | index := anEvent keyValue - 48. itemToSelect := (submorphs select: [ :each | each isKindOf: DockingBarItemMorph ]) at: index ifAbsent: [ ^self ]. self activate: anEvent. self selectItem: itemToSelect event: anEvent ]! ! !DockingBarMorph methodsFor: 'events-processing' stamp: 'kb 2/4/2010 11:30'! handlesKeyboard: evt ^true! ! !DockingBarMorph methodsFor: 'events-processing' stamp: 'kb 2/26/2010 14:02'! keyStroke: evt | asc | asc := evt keyCharacter asciiValue. asc = 27 ifTrue: [ "escape key" ^self deactivate: evt ]. asc = self selectSubmenuKey ifTrue: [ self ensureSelectedItem: evt. self selectedItem subMenu ifNotNil: [ :subMenu | subMenu items ifNotEmpty: [ subMenu activate: evt. ^subMenu moveSelectionDown: 1 event: evt ] ] ]. asc = self previousKey ifTrue: [ ^self moveSelectionDown: -1 event: evt ]. asc = self nextKey ifTrue: [ ^self moveSelectionDown: 1 event: evt ]. selectedItem ifNotNil: [ selectedItem subMenu ifNotNil: [ :subMenu | " If we didn't handle the keystroke, pass the keyboard focus to the open submenu. " evt hand newKeyboardFocus: subMenu. subMenu keyStroke: evt ] ]! ! !DockingBarMorph methodsFor: 'events-processing' stamp: 'kb 2/4/2010 12:33'! nextKey self isHorizontal ifTrue: [ ^29 " right arrow" ]. self isVertical ifTrue: [ ^31 " down arrow " ]! ! !DockingBarMorph methodsFor: 'events-processing' stamp: 'kb 2/4/2010 12:33'! previousKey self isHorizontal ifTrue: [ ^28 "left arrow" ]. self isVertical ifTrue: [ ^30 "up arrow " ]! ! !DockingBarMorph methodsFor: 'events-processing' stamp: 'kb 2/4/2010 13:03'! selectSubmenuKey self isAdheringToTop ifTrue: [ ^31 ]. self isAdheringToRight ifTrue: [ ^28 ]. self isAdheringToLeft ifTrue: [ ^29 ]. self isAdheringToBottom ifTrue: [ 30 ]. ^31! ! !DockingBarMorph methodsFor: 'initialization' stamp: 'kb 2/22/2010 09:41'! initialize "initialize the receiver" super initialize. "" selectedItem := nil. activeSubMenu := nil. fillsOwner := true. avoidVisibleBordersAtEdge := true. autoGradient := Preferences gradientMenu. "" self setDefaultParameters. "" self beFloating; beSticky. "" self layoutInset: 0. Project current world activeHand addKeyboardListener: self! ! !DockingBarMorph methodsFor: 'private' stamp: 'kb 2/22/2010 15:06'! selectedItem (selectedItem notNil and: [ selectedItem isSelected ]) ifTrue: [ ^selectedItem ]. ^ nil! ! !MenuItemMorph methodsFor: 'accessing' stamp: 'kb 2/4/2010 14:14'! addSubMenu: aBlock subMenu := self createSubmenu. aBlock value: subMenu. self changed. ! ! !MenuItemMorph methodsFor: 'accessing' stamp: 'kb 2/4/2010 14:13'! subMenuUpdater: updater selector: selector subMenu := self createUpdatingSubmenu. subMenu updater: updater updateSelector: selector. self changed. ! ! !MenuItemMorph methodsFor: 'accessing' stamp: 'kb 2/4/2010 14:13'! subMenuUpdater: updater selector: selector arguments: arguments subMenu := self createUpdatingSubmenu. subMenu updater: updater updateSelector: selector arguments: arguments. self changed. ! ! !MenuItemMorph methodsFor: 'private' stamp: 'kb 2/4/2010 14:13'! createSubmenu ^MenuMorph new! ! !MenuItemMorph methodsFor: 'private' stamp: 'kb 2/4/2010 14:13'! createUpdatingSubmenu ^UpdatingMenuMorph new! ! !DockingBarItemMorph methodsFor: 'events' stamp: 'kb 2/4/2010 14:39'! mouseDown: evt "Handle a mouse down event. Menu items get activated when the mouse is over them." evt shiftPressed ifTrue: [ ^super mouseDown: evt ]. "enable label editing" isSelected ifTrue: [ evt hand newMouseFocus: nil. owner selectItem: nil event: evt. ] ifFalse: [ (self containsPoint: evt position) ifFalse: [ self halt ]. owner activate: evt. "Redirect to menu for valid transitions" owner selectItem: self event: evt. ] ! ! !DockingBarItemMorph methodsFor: 'private' stamp: 'kb 2/4/2010 14:15'! createSubmenu ^DockingBarMenuMorph new! ! !DockingBarItemMorph methodsFor: 'private' stamp: 'kb 2/4/2010 14:15'! createUpdatingSubmenu ^DockingBarUpdatingMenuMorph new! ! !MenuMorph methodsFor: 'control' stamp: 'kb 2/22/2010 10:20'! activeSubmenu: aSubmenu activeSubMenu ifNotNil: [ activeSubMenu delete ]. activeSubMenu := aSubmenu. activeSubMenu ifNotNil: [ activeSubMenu updateMenu ]! ! !MenuMorph methodsFor: 'control' stamp: 'kb 2/22/2010 12:00'! popUpAdjacentTo: rightOrLeftPoint forHand: hand from: sourceItem "Present this menu at the given point under control of the given hand." | tryToPlace selectedOffset | hand world startSteppingSubmorphsOf: self. popUpOwner := sourceItem. self fullBounds. self updateColor. "ensure layout is current" selectedOffset := (selectedItem ifNil: [self items first]) position - self position. tryToPlace := [:where :mustFit | | delta | self position: where - selectedOffset. delta := self fullBoundsInWorld amountToTranslateWithin: sourceItem worldBounds. (delta x = 0 or: [mustFit]) ifTrue: [delta = (0 @ 0) ifFalse: [self position: self position + delta]. sourceItem owner owner addMorphFront: self. ^ self]]. tryToPlace value: rightOrLeftPoint first value: false; value: rightOrLeftPoint last - (self width @ 0) value: false; value: rightOrLeftPoint first value: true! ! !MenuMorph methodsFor: 'copying' stamp: 'kb 2/22/2010 10:15'! veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment." super veryDeepInner: deepCopier. "defaultTarget := defaultTarget. Weakly copied" selectedItem := selectedItem veryDeepCopyWith: deepCopier. stayUp := stayUp veryDeepCopyWith: deepCopier. popUpOwner := popUpOwner. "Weakly copied" activeSubMenu := activeSubMenu. "Weakly copied" ! ! !MenuMorph methodsFor: 'events' stamp: 'kb 2/4/2010 13:06'! activate: evt "Receiver should be activated; e.g., so that control passes correctly." evt hand newMouseFocus: self; newKeyboardFocus: self! ! !MenuMorph methodsFor: 'events' stamp: 'kb 2/24/2010 13:14'! deactivate: evt "If a stand-alone menu, just delete it" popUpOwner ifNil: [ self delete. ^true ]. "If a sub-menu, then deselect, and return focus to outer menu" self selectItem: nil event: evt. evt hand newMouseFocus: popUpOwner owner. evt hand newKeyboardFocus: popUpOwner owner! ! !MenuMorph methodsFor: 'keyboard control' stamp: 'kb 2/22/2010 16:33'! keyStroke: evt self showKeyboardHelp; noteRootMenuHasUsedKeyboard. self keyStrokeHandlers detect: [ :each | self perform: each with: evt ] ifNone: [ self handleFiltering: evt ].! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/22/2010 16:05'! handleCRStroke: evt | selectable | evt keyValue = 13 ifFalse: [ ^false ]. selectedItem ifNotNil: [ selectedItem hasSubMenu ifTrue: [ evt hand newMouseFocus: selectedItem subMenu; newKeyboardFocus: selectedItem subMenu ] ifFalse: [ selectedItem invokeWithEvent: evt ]. ^true ]. (selectable := self items) size = 1 ifTrue: [ selectable first invokeWithEvent: evt ]. ^true! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/22/2010 15:54'! handleCommandKeyPress: evt (evt commandKeyPressed and: [ self commandKeyHandler notNil ]) ifTrue: [ self commandKeyHandler commandKeyTypedIntoMenu: evt. self deleteIfPopUp: evt. ^true ]. ^false! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/22/2010 16:31'! handleDownStroke: evt evt keyValue = 31 ifFalse: [ ^false ]. self moveSelectionDown: 1 event: evt. ^true! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/24/2010 13:15'! handleEscStroke: evt evt keyValue = 27 ifFalse: [ ^false ]. self valueOfProperty: #matchString ifPresentDo: [ :str | str isEmpty ifFalse: [ "If filtered, first ESC removes filter" self setProperty: #matchString toValue: String new. self selectItem: nil event: evt. self displayFiltered: evt. ^true ] ]. self deactivate: evt. ^true! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/22/2010 16:35'! handleFiltering: evt | matchString | matchString := self valueOfProperty: #matchString ifAbsentPut: [ String new ]. matchString := evt keyValue = 8 " Character backspace asciiValue " ifTrue: [ matchString isEmpty ifTrue: [ matchString ] ifFalse: [ matchString allButLast ] ] ifFalse: [ matchString copyWith: evt keyCharacter ]. self setProperty: #matchString toValue: matchString. self displayFiltered: evt. self showKeyboardHelp ! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/24/2010 10:41'! handleLeftStroke: evt 28 = evt keyValue ifFalse: [ ^false ]. self stepIntoSubmenu: evt. ^true! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/22/2010 16:30'! handlePageDownStorke: evt evt keyValue = 12 ifFalse: [ ^false ]. self moveSelectionDown: 5 event: evt. ^true! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/22/2010 16:35'! handlePageDownStroke: evt evt keyValue = 12 ifFalse: [ ^false ]. self moveSelectionDown: 5 event: evt. ^true! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/22/2010 16:34'! handlePageUpStroke: evt evt keyValue = 11 ifFalse: [ ^false ]. self moveSelectionDown: -5 event: evt. ^true! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/24/2010 10:40'! handleRightStorke: evt 29 = evt keyValue ifFalse: [ ^false ]. self stepIntoSubmenu: evt. ^true! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/24/2010 10:48'! handleRightStroke: evt 29 = evt keyValue ifFalse: [ ^false ]. self stepIntoSubmenu: evt. ^true! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/22/2010 16:12'! handleUpStorke: evt evt keyValue = 30 ifFalse: [ ^false ]. self moveSelectionDown: -1 event: evt. ^true! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/24/2010 10:49'! keyStrokeHandlers ^#( handleCommandKeyPress: handleCRStroke: handleEscStroke: handleLeftStroke: handleRightStroke: handleUpStorke: handleDownStroke: handlePageUpStroke: handlePageDownStroke:)! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/22/2010 15:53'! noteRootMenuHasUsedKeyboard (self rootMenu hasProperty: #hasUsedKeyboard) ifFalse: [ self setProperty: #hasUsedKeyboard toValue: true. self changed ].! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/22/2010 15:48'! showKeyboardHelp | help | help := BalloonMorph string: 'Enter text to\narrow selection down\to matching items ' withCRs for: self corner: #topLeft. help popUpForHand: self activeHand! ! !MenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/24/2010 10:39'! stepIntoSubmenu: evt (selectedItem notNil and: [ selectedItem hasSubMenu ]) ifTrue: [ evt hand newMouseFocus: selectedItem subMenu. evt hand newKeyboardFocus: selectedItem subMenu. selectedItem subMenu moveSelectionDown: 1 event: evt. ^true ]. ^false! ! !DockingBarMenuMorph methodsFor: 'as yet unclassified' stamp: 'kb 2/22/2010 10:21'! activatedFromDockingBar: aDockingBar activatorDockingBar := aDockingBar! ! !DockingBarMenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/22/2010 16:41'! handleCRStroke: evt evt keyValue = 13 ifFalse: [ ^false ]. selectedItem ifNotNil: [ selectedItem invokeWithEvent: evt ]. ^true! ! !DockingBarMenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/24/2010 13:16'! handleLeftStroke: evt 28 = evt keyValue ifFalse: [ ^false ]. (self stepIntoSubmenu: evt) ifFalse: [ self deactivate: evt. activatorDockingBar moveSelectionDown: -1 event: evt ]. ^true! ! !DockingBarMenuMorph methodsFor: 'keystroke helpers' stamp: 'kb 2/24/2010 13:16'! handleRightStroke: evt 29 = evt keyValue ifFalse: [ ^false ]. (self stepIntoSubmenu: evt) ifFalse: [ self deactivate: evt. activatorDockingBar moveSelectionDown: 1 event: evt ]. ^true! ! !DockingBarMenuMorph methodsFor: 'rounding' stamp: 'kb 2/22/2010 10:13'! roundedCorners "Return a list of those corners to round" activatorDockingBar isFloating ifTrue: [^ #(2 3 )]. activatorDockingBar isAdheringToTop ifTrue: [^ #(2 3 )]. activatorDockingBar isAdheringToBottom ifTrue: [^ #(1 4 )]. activatorDockingBar isAdheringToLeft ifTrue: [^ #(3 4 )]. activatorDockingBar isAdheringToRight ifTrue: [^ #(1 2 )]! ! !DockingBarMenuMorph methodsFor: 'copying' stamp: 'kb 2/22/2010 10:16'! veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment." super veryDeepInner: deepCopier. activatorDockingBar := activatorDockingBar. "Weakly copied" ! ! !DockingBarUpdatingMenuMorph methodsFor: 'as yet unclassified' stamp: 'kb 2/22/2010 14:59'! initialize super initialize. menuUpdater := MenuUpdater new! ! !DockingBarUpdatingMenuMorph methodsFor: 'as yet unclassified' stamp: 'kb 2/22/2010 15:00'! updateMenu menuUpdater update: self! ! !DockingBarUpdatingMenuMorph methodsFor: 'as yet unclassified' stamp: 'kb 2/22/2010 14:59'! updater: anObject updateSelector: aSelector menuUpdater updater: anObject updateSelector: aSelector! ! !DockingBarUpdatingMenuMorph methodsFor: 'as yet unclassified' stamp: 'kb 2/22/2010 14:59'! updater: anObject updateSelector: aSelector arguments: anArray menuUpdater updater: anObject updateSelector: aSelector arguments: anArray! ! !MenuUpdater methodsFor: 'as yet unclassified' stamp: 'kb 2/22/2010 14:58'! update: aMenuMorph "Reconstitute the menu by first removing the contents and then building it afresh" aMenuMorph removeAllMorphs. arguments ifNil: [ updater perform: updateSelector with: aMenuMorph ] ifNotNil: [ updater perform: updateSelector withArguments: (arguments copyWith: aMenuMorph) ]. aMenuMorph changed! ! !MenuUpdater methodsFor: 'as yet unclassified' stamp: 'kb 2/22/2010 14:54'! updater: anObject updateSelector: aSelector self updater: anObject updateSelector: aSelector arguments: nil! ! !MenuUpdater methodsFor: 'as yet unclassified' stamp: 'kb 2/22/2010 14:53'! updater: anObject updateSelector: aSelector arguments: anArray updater := anObject. updateSelector := aSelector. arguments := anArray! ! !ProportionalSplitterMorph methodsFor: 'controlled morphs' stamp: 'bvs 3/24/2004 16:57'! addLeftOrTop: aMorph leftOrTop add: aMorph! ! !ProportionalSplitterMorph methodsFor: 'controlled morphs' stamp: 'bvs 3/24/2004 16:55'! addRightOrBottom: aMorph rightOrBottom add: aMorph. ! ! !ProportionalSplitterMorph methodsFor: 'controlled morphs' stamp: 'ml 9/25/2009 08:31'! bordersOn: aMorph "Answer true if the aMorph is one of my neighbours." ^ (leftOrTop includes: aMorph) or: [rightOrBottom includes: aMorph]! ! !ProportionalSplitterMorph methodsFor: 'controlled morphs' stamp: 'ml 9/25/2009 08:29'! commonNeighbours: morphs with: aProportionalSplitterMorphOrNil "Answer the subset of morphs which is also confined by aProportionalSplitterMorphOrNil." ^ aProportionalSplitterMorphOrNil isNil ifTrue: [morphs] ifFalse: [morphs select: [ :which | aProportionalSplitterMorphOrNil bordersOn: which]]! ! !ProportionalSplitterMorph methodsFor: 'direction' stamp: 'bvs 3/24/2004 16:39'! beSplitsTopAndBottom splitsTopAndBottom := true. ! ! !ProportionalSplitterMorph methodsFor: 'direction' stamp: 'bvs 3/24/2004 17:25'! splitsTopAndBottom ^ splitsTopAndBottom! ! !ProportionalSplitterMorph methodsFor: 'boundaries' stamp: 'ml 9/25/2009 10:55'! bottomBoundary "Answert the bottommost x position the receiver could be moved." | splitter morphs | splitter := self splitterBelow. morphs := self commonNeighbours: rightOrBottom with: splitter. ^ (splitter ifNil: [self containingWindow panelRect bottom] ifNotNil: [splitter top]) - (self minimumHeightOf: morphs)! ! !ProportionalSplitterMorph methodsFor: 'boundaries' stamp: 'ml 9/25/2009 10:57'! leftBoundary "Answer the leftmost y position the receiver could be moved." | splitter morphs | splitter := self splitterLeft. morphs := self commonNeighbours: leftOrTop with: splitter. ^ (splitter ifNil: [self containingWindow panelRect left] ifNotNil: [splitter right]) + (self minimumWidthOf: morphs)! ! !ProportionalSplitterMorph methodsFor: 'boundaries' stamp: 'ml 10/2/2009 18:09'! minimumHeightOf: aCollection "Answer the minimum height needed to display any of the morphs in aCollection." ^ aCollection inject: 0 into: [ :height :morph | (morph minHeight + self height) max: height]! ! !ProportionalSplitterMorph methodsFor: 'boundaries' stamp: 'ml 10/2/2009 18:08'! minimumWidthOf: aCollection "Answer the minimum width needed to display any of the morphs in aCollection." ^ aCollection inject: 0 into: [ :width :morph | (morph minWidth + self width) max: width]! ! !ProportionalSplitterMorph methodsFor: 'boundaries' stamp: 'jrp 3/21/2006 22:45'! normalizedX: x ^ (x max: self leftBoundary) min: self rightBoundary! ! !ProportionalSplitterMorph methodsFor: 'boundaries' stamp: 'jrp 3/21/2006 23:12'! normalizedY: y ^ (y max: self topBoundary) min: self bottomBoundary! ! !ProportionalSplitterMorph methodsFor: 'boundaries' stamp: 'ml 9/25/2009 11:01'! rightBoundary "Answer the rightmost x position the receiver could be moved to." | splitter morphs | splitter := self splitterRight. morphs := self commonNeighbours: rightOrBottom with: splitter. ^ (splitter ifNil: [self containingWindow panelRect right] ifNotNil: [splitter left]) - (self minimumWidthOf: morphs)! ! !ProportionalSplitterMorph methodsFor: 'boundaries' stamp: 'ml 9/25/2009 10:52'! topBoundary "Answer the topmost x position the receiver could be moved to." | splitter morphs | splitter := self splitterAbove. morphs := self commonNeighbours: leftOrTop with: splitter. ^ (splitter ifNil: [self containingWindow panelRect top] ifNotNil: [splitter bottom]) + (self minimumHeightOf: morphs)! ! !ProportionalSplitterMorph methodsFor: 'displaying' stamp: 'jrp 8/6/2005 23:59'! drawOn: aCanvas | dotBounds size alphaCanvas dotSize | super drawOn: aCanvas. self class showSplitterHandles ifTrue: [ size := self splitsTopAndBottom ifTrue: [self handleSize transposed] ifFalse: [self handleSize]. dotSize := self splitsTopAndBottom ifTrue: [6 @ self class splitterWidth] ifFalse: [self class splitterWidth @ 6]. alphaCanvas := aCanvas asAlphaBlendingCanvas: 0.7. dotBounds := Rectangle center: self bounds center extent: size. alphaCanvas fillRectangle: dotBounds color: self handleColor. dotBounds := Rectangle center: self bounds center extent: dotSize. alphaCanvas fillRectangle: dotBounds color: self dotColor]! ! !ProportionalSplitterMorph methodsFor: 'displaying' stamp: 'apl 7/8/2005 13:38'! getOldColor ^ oldColor ifNil: [Color transparent]! ! !ProportionalSplitterMorph methodsFor: 'displaying' stamp: 'jrp 7/4/2005 10:50'! handleRect ^ Rectangle center: self bounds center extent: (self splitsTopAndBottom ifTrue: [self handleSize transposed] ifFalse: [self handleSize])! ! !ProportionalSplitterMorph methodsFor: 'displaying' stamp: 'jrp 8/6/2005 23:59'! handleSize ^ self class splitterWidth @ 30! ! !ProportionalSplitterMorph methodsFor: 'displaying' stamp: 'jrp 7/9/2005 17:44'! isCursorOverHandle ^ self class showSplitterHandles not or: [self handleRect containsPoint: ActiveHand cursorPoint]! ! !ProportionalSplitterMorph methodsFor: 'displaying' stamp: 'bvs 3/24/2004 16:39'! resizeCursor ^ Cursor resizeForEdge: (splitsTopAndBottom ifTrue: [#top] ifFalse: [#left]) ! ! !ProportionalSplitterMorph methodsFor: 'initialization' stamp: 'jrp 7/5/2005 21:46'! initialize super initialize. self hResizing: #spaceFill. self vResizing: #spaceFill. splitsTopAndBottom := false. leftOrTop := OrderedCollection new. rightOrBottom := OrderedCollection new! ! !ProportionalSplitterMorph methodsFor: 'events' stamp: 'jrp 7/9/2005 17:44'! mouseDown: anEvent (self class showSplitterHandles not and: [self bounds containsPoint: anEvent cursorPoint]) ifTrue: [oldColor := self color. self color: Color black]. ^ super mouseDown: anEvent ! ! !ProportionalSplitterMorph methodsFor: 'events' stamp: 'jrp 3/21/2006 23:11'! mouseMove: anEvent anEvent hand temporaryCursor ifNil: [^ self]. self class fastSplitterResize ifFalse: [self updateFromEvent: anEvent] ifTrue: [traceMorph ifNil: [traceMorph := Morph newBounds: self bounds. traceMorph borderColor: Color lightGray. traceMorph borderWidth: 1. self owner addMorph: traceMorph]. splitsTopAndBottom ifTrue: [traceMorph position: traceMorph position x @ (self normalizedY: anEvent cursorPoint y)] ifFalse: [traceMorph position: (self normalizedX: anEvent cursorPoint x) @ traceMorph position y]]! ! !ProportionalSplitterMorph methodsFor: 'events' stamp: 'jrp 7/8/2005 21:42'! mouseUp: anEvent (self bounds containsPoint: anEvent cursorPoint) ifFalse: [anEvent hand showTemporaryCursor: nil]. self class fastSplitterResize ifTrue: [self updateFromEvent: anEvent]. traceMorph ifNotNil: [traceMorph delete. traceMorph := nil]. self color: self getOldColor! ! !ProportionalSplitterMorph methodsFor: 'events' stamp: 'nice 12/27/2009 03:11'! updateFromEvent: anEvent | delta selfTop selfBottom selfLeft selfRight | delta := splitsTopAndBottom ifTrue: [0 @ ((self normalizedY: anEvent cursorPoint y) - lastMouse y)] ifFalse: [(self normalizedX: anEvent cursorPoint x) - lastMouse x @ 0]. splitsTopAndBottom ifTrue: [lastMouse := lastMouse x @ (self normalizedY: anEvent cursorPoint y)] ifFalse: [lastMouse := (self normalizedX: anEvent cursorPoint x) @ lastMouse y]. leftOrTop do: [:each | | firstRight firstBottom | firstRight := each layoutFrame rightOffset ifNil: [0]. firstBottom := each layoutFrame bottomOffset ifNil: [0]. each layoutFrame rightOffset: firstRight + delta x. each layoutFrame bottomOffset: firstBottom + delta y]. rightOrBottom do: [:each | | secondLeft secondTop | secondLeft := each layoutFrame leftOffset ifNil: [0]. secondTop := each layoutFrame topOffset ifNil: [0]. each layoutFrame leftOffset: secondLeft + delta x. each layoutFrame topOffset: secondTop + delta y]. selfTop := self layoutFrame topOffset ifNil: [0]. selfBottom := self layoutFrame bottomOffset ifNil: [0]. selfLeft := self layoutFrame leftOffset ifNil: [0]. selfRight := self layoutFrame rightOffset ifNil: [0]. self layoutFrame topOffset: selfTop + delta y. self layoutFrame bottomOffset: selfBottom + delta y. self layoutFrame leftOffset: selfLeft + delta x. self layoutFrame rightOffset: selfRight + delta x. self owner layoutChanged! ! !ProportionalSplitterMorph methodsFor: 'events' stamp: 'bvs 3/24/2004 16:39'! wantsEveryMouseMove ^ true! ! !ProportionalSplitterMorph methodsFor: 'adjacent splitters' stamp: 'nice 1/1/2010 21:55'! siblingSplitters ^ self owner submorphsSatisfying: [:each | (each isKindOf: self class) and: [self splitsTopAndBottom = each splitsTopAndBottom and: [each ~= self]]]! ! !ProportionalSplitterMorph methodsFor: 'adjacent splitters' stamp: 'jrp 3/21/2006 23:01'! splitterAbove | splitters | splitters := ((self siblingSplitters select: [:each | each y > self y]) asSortedCollection: [:a :b | a y < b y]). ^ splitters ifEmpty: nil ifNotEmpty: [splitters first]! ! !ProportionalSplitterMorph methodsFor: 'adjacent splitters' stamp: 'jrp 3/21/2006 23:01'! splitterBelow | splitters | splitters := ((self siblingSplitters select: [:each | each y < self y]) asSortedCollection: [:a :b | a y > b y]). ^ splitters ifEmpty: nil ifNotEmpty: [splitters first]! ! !ProportionalSplitterMorph methodsFor: 'adjacent splitters' stamp: 'jrp 3/21/2006 23:03'! splitterLeft | splitters | splitters := ((self siblingSplitters select: [:each | each x < self x]) asSortedCollection: [:a :b | a x > b x]). ^ splitters ifEmpty: nil ifNotEmpty: [splitters first]! ! !ProportionalSplitterMorph methodsFor: 'adjacent splitters' stamp: 'jrp 3/21/2006 23:03'! splitterRight | splitters | splitters := ((self siblingSplitters select: [:each | each x > self x]) asSortedCollection: [:a :b | a x < b x]). ^ splitters ifEmpty: nil ifNotEmpty: [splitters first]! ! !TextEditor methodsFor: 'attributes' stamp: 'kb 2/23/2010 12:46'! changeStyle "Let user change styles for the current text pane." | names reply style current menuList | current := paragraph textStyle. names := TextStyle knownTextStyles. menuList := names collect: [ :styleName | styleName = current name ifTrue: [ '', styleName ] ifFalse: [ '', styleName ]]. reply := UIManager default chooseFrom: menuList values: names. reply ifNotNil: [ (style := TextStyle named: reply) ifNil: [Beeper beep. ^ true]. paragraph textStyle: style. paragraph composeAll. self recomputeSelection]. ^ true! ! !TheWorldMainDockingBar methodsFor: 'submenu - windows' stamp: 'laza 3/3/2010 05:00'! listWindowsOn: menu | windows | windows := SortedCollection sortBlock: [:winA :winB | winA model name = winB model name ifTrue: [winA label < winB label] ifFalse: [winA model name < winB model name]]. windows addAll: self allVisibleWindows. windows ifEmpty: [ menu addItem: [ :item | item contents: 'No Windows' translated; isEnabled: false ] ]. windows do: [ :each | menu addItem: [ :item | item contents: (self windowMenuItemLabelFor: each); icon: (self colorIcon: each paneColor); target: each; selector: #comeToFront; subMenuUpdater: self selector: #windowMenuFor:on: arguments: { each }; action: [ each activateAndForceLabelToShow; expand ] ] ].! ! !UpdatingMenuMorph methodsFor: 'initialization' stamp: 'kb 2/22/2010 14:57'! initialize super initialize. menuUpdater := MenuUpdater new! ! !UpdatingMenuMorph methodsFor: 'initialization' stamp: 'kb 2/22/2010 14:58'! updater: anObject updateSelector: aSelector menuUpdater updater: anObject updateSelector: aSelector! ! !UpdatingMenuMorph methodsFor: 'initialization' stamp: 'kb 2/22/2010 14:58'! updater: anObject updateSelector: aSelector arguments: anArray menuUpdater updater: anObject updateSelector: aSelector arguments: anArray! ! !UpdatingMenuMorph methodsFor: 'update' stamp: 'kb 2/22/2010 15:00'! updateMenu menuUpdater update: self! ! !UpdatingMenuMorph methodsFor: 'as yet unclassified' stamp: 'kb 2/22/2010 15:00'! activate: evt "Receiver should be activated; e.g., so that control passes correctly." self updateMenu. super activate: evt! ! !UserDialogBoxMorph methodsFor: 'events' stamp: 'ar 2/24/2010 00:55'! mouseDown: event "Always bring me to the front since I am modal" self comeToFront. (self containsPoint: event position) ifFalse:[ Beeper beepPrimitive. ^self flash]. event hand grabMorph: self.! ! MenuMorph subclass: #UpdatingMenuMorph instanceVariableNames: 'menuUpdater' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Menus'! MenuMorph removeSelector: #activatedFromDockingBar:! MenuMorph removeSelector: #moveDown:! MenuMorph removeSelector: #moveRightOrDown:! MenuMorph removeSelector: #moveUp:! MenuMorph removeSelector: #roundedCorners! MenuMorph removeSelector: #wasActivatedFromDockingBar! AlignmentMorph subclass: #MenuMorph instanceVariableNames: 'defaultTarget selectedItem stayUp popUpOwner activeSubMenu' classVariableNames: 'CloseBoxImage PushPinImage' poolDictionaries: '' category: 'Morphic-Menus'! CornerGripMorph initialize! CornerGripMorph class instanceVariableNames: ''! AbstractResizerMorph subclass: #CornerGripMorph instanceVariableNames: 'target' classVariableNames: 'ActiveForm PassiveForm' poolDictionaries: '' category: 'Morphic-Windows'!