'From Squeak3.2alpha of 3 October 2001 [latest update: #4621] on 17 December 2001 at 5:32:35 pm'! "Change Set: kbdFocus-sw Date: 17 December 2001 Author: Scott Wallace Provides variant calls to various menu functions so that the seizing of keyboard focus can be avoided when necessary, such as when asserting text-style changes via a halo menu"! !MenuMorph methodsFor: 'control' stamp: 'sw 12/17/2001 16:39'! popUpAt: aPoint forHand: hand in: aWorld "Present this menu at the given point under control of the given hand. Allow keyboard input into the menu." ^ self popUpAt: aPoint forHand: hand in: aWorld allowKeyboard: true! ! !MenuMorph methodsFor: 'control' stamp: 'sw 12/17/2001 16:44'! popUpAt: aPoint forHand: hand in: aWorld allowKeyboard: aBoolean "Present this menu at the given point under control of the given hand." | evt | self items isEmpty ifTrue: [^ self]. self positionAt: aPoint relativeTo: (selectedItem ifNil:[self items first]) inWorld: aWorld. aWorld addMorphFront: self; startSteppingSubmorphsOf: self. "Aquire focus for valid pop up behavior" hand newMouseFocus: self. aBoolean ifTrue: [hand newKeyboardFocus: self]. evt _ hand lastEvent. (evt isKeyboard or: [evt isMouse and: [evt anyButtonPressed not]]) ifTrue: ["Select first item if button not down" self moveSelectionDown: 1 event: evt]. self changed! ! !MenuMorph methodsFor: 'control' stamp: 'sw 12/17/2001 16:43'! popUpNoKeyboard "Present this menu in the current World, *not* allowing keyboard input into the menu" ^ self popUpAt: ActiveHand position forHand: ActiveHand in: ActiveWorld allowKeyboard: false! ! !MVCMenuMorph methodsFor: 'invoking' stamp: 'sw 12/17/2001 17:06'! invokeAt: aPoint in: aWorld "Add this menu to the given world centered at the given point. Wait for the user to make a selection and answer it. The selection value returned is an integer in keeping with PopUpMenu, if the menu is converted from an MVC-style menu." "Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop." ^ self invokeAt: aPoint in: aWorld allowKeyboard: true! ! !MVCMenuMorph methodsFor: 'invoking' stamp: 'sw 12/17/2001 16:50'! invokeAt: aPoint in: aWorld allowKeyboard: aBoolean "Add this menu to the given world centered at the given point. Wait for the user to make a selection and answer it. The selection value returned is an integer in keeping with PopUpMenu, if the menu is converted from an MVC-style menu." "Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop." | w | self flag: #bob. "is global or local?" self flag: #arNote. " is local to aWorld" self popUpAt: aPoint forHand: aWorld primaryHand in: aWorld allowKeyboard: aBoolean. done _ false. w _ aWorld outermostWorldMorph. "containing hand" [self isInWorld & done not] whileTrue: [w doOneSubCycle]. self delete. ^ mvcSelection ! ! !PopUpMenu methodsFor: 'basic control sequence' stamp: 'sw 12/17/2001 17:26'! startUpSegmented: segmentHeight withCaption: captionOrNil at: location allowKeyboard: aBoolean "This menu is too big to fit comfortably on the screen. Break it up into smaller chunks, and manage the relative indices. Inspired by a special-case solution by Reinier van Loon. The boolean parameter indicates whether the menu should be given keyboard focus (if in morphic)" " (PopUpMenu labels: (String streamContents: [:s | 1 to: 100 do: [:i | s print: i; cr]. s skip: -1]) lines: (5 to: 100 by: 5)) startUpWithCaption: 'Give it a whirl...'. " | nLines nLinesPer allLabels from to subset subLines index | frame ifNil: [self computeForm]. allLabels := labelString findTokens: Character cr asString. nLines _ allLabels size. lineArray ifNil: [lineArray _ Array new]. nLinesPer _ segmentHeight // marker height - 3. from := 1. [ true ] whileTrue: [to := (from + nLinesPer) min: nLines. subset := allLabels copyFrom: from to: to. subset add: (to = nLines ifTrue: ['start over...'] ifFalse: ['more...']) before: subset first. subLines _ lineArray select: [:n | n >= from] thenCollect: [:n | n - (from-1) + 1]. subLines _ (Array with: 1) , subLines. index := (PopUpMenu labels: subset asStringWithCr lines: subLines) startUpWithCaption: captionOrNil at: location allowKeyboard: aBoolean. index = 1 ifTrue: [from := to + 1. from > nLines ifTrue: [ from := 1 ]] ifFalse: [index = 0 ifTrue: [^ 0]. ^ from + index - 2]]! ! !PopUpMenu methodsFor: 'basic control sequence' stamp: 'sw 12/17/2001 17:10'! startUpWithCaption: captionOrNil at: location "Display the menu, with caption if supplied. Wait for the mouse button to go down, then track the selection as long as the button is pressed. When the button is released, answer the index of the current selection, or zero if the mouse is not released over any menu item. Location specifies the desired topLeft of the menu body rectangle." ^ self startUpWithCaption: captionOrNil at: location allowKeyboard: true! ! !PopUpMenu methodsFor: 'basic control sequence' stamp: 'sw 12/17/2001 17:09'! startUpWithCaption: captionOrNil at: location allowKeyboard: aBoolean "Display the menu, with caption if supplied. Wait for the mouse button to go down, then track the selection as long as the button is pressed. When the button is released, Answer the index of the current selection, or zero if the mouse is not released over any menu item. Location specifies the desired topLeft of the menu body rectangle. The final argument indicates whether the menu should seize the keyboard focus in order to allow the user to navigate it via the keyboard." | maxHeight | maxHeight _ Display height*3//4. self frameHeight > maxHeight ifTrue: [^ self startUpSegmented: maxHeight withCaption: captionOrNil at: location allowKeyboard: aBoolean]. Smalltalk isMorphic ifTrue:[ selection _ Cursor normal showWhile: [(MVCMenuMorph from: self title: captionOrNil) invokeAt: location in: ActiveWorld allowKeyboard: aBoolean]. ^ selection]. frame ifNil: [self computeForm]. Cursor normal showWhile: [self displayAt: location withCaption: captionOrNil during: [self controlActivity]]. ^ selection! ! !PopUpMenu methodsFor: 'basic control sequence' stamp: 'sw 12/17/2001 17:01'! startUpWithoutKeyboard "Display and make a selection from the receiver as long as the button is pressed. Answer the current selection. Do not allow keyboard input into the menu" ^ self startUpWithCaption: nil at: ((ActiveHand ifNil:[Sensor]) cursorPoint) allowKeyboard: false! ! !SelectionMenu methodsFor: 'basic control sequence' stamp: 'sw 12/17/2001 17:26'! startUpWithCaption: captionOrNil at: location allowKeyboard: aBoolean "Overridden to return value returned by manageMarker. The boolean parameter indicates whether the menu should be given keyboard focus (if in morphic)" | index | index _ super startUpWithCaption: captionOrNil at: location allowKeyboard: aBoolean. (selections = nil or: [(index between: 1 and: selections size) not]) ifTrue: [^ nil]. ^ selections at: index! ! !TextMorphEditor methodsFor: 'attributes' stamp: 'sw 12/17/2001 17:31'! changeEmphasisOrAlignment | aList reply code align menuList | self flag: #arNote. "Move this up once we get rid of MVC" aList _ #(plain bold italic narrow underlined struckOut leftFlush centered rightFlush justified). align _ paragraph text alignmentAt: startBlock stringIndex ifAbsent:[paragraph textStyle alignment]. code _ paragraph text emphasisAt: startBlock stringIndex. menuList _ WriteStream on: Array new. menuList nextPut: (code = 0 ifTrue:['plain'] ifFalse:['plain']). menuList nextPutAll: (#(bold italic underlined struckOut) collect:[:emph| (code anyMask: (TextEmphasis perform: emph) emphasisCode) ifTrue:['', emph] ifFalse:['',emph]]). ((paragraph text attributesAt: startBlock stringIndex forStyle: paragraph textStyle) anySatisfy:[:attr| attr isKern and:[attr kern < 0]]) ifTrue:[menuList nextPut:'narrow'] ifFalse:[menuList nextPut:'narrow']. menuList nextPutAll: (#(leftFlush centered rightFlush justified) collectWithIndex:[:type :i| align = (i-1) ifTrue:['',type] ifFalse:['',type]]). aList _ #(plain bold italic underlined struckOut narrow leftFlush centered rightFlush justified). reply _ (SelectionMenu labelList: menuList contents lines: #(1 6) selections: aList) startUpWithoutKeyboard. reply ~~ nil ifTrue: [(#(leftFlush centered rightFlush justified) includes: reply) ifTrue: [self setAlignment: reply. paragraph composeAll. self recomputeInterval] ifFalse: [self setEmphasis: reply. paragraph composeAll. self recomputeSelection. self mvcRedisplay]]. ^ true! ! !TextMorphEditor methodsFor: 'attributes' stamp: 'sw 12/17/2001 16:43'! changeTextFont "Present a menu of available fonts, and if one is chosen, apply it to the current selection." | curFont fontList fontMenu style active ptMenu label | curFont _ (paragraph text fontAt: startBlock stringIndex withStyle: paragraph textStyle). fontList _ StrikeFont familyNames remove: 'DefaultTextStyle' ifAbsent: []; asOrderedCollection. fontMenu _ MenuMorph new defaultTarget: self. fontList do:[:fontName| style _ TextStyle named: fontName. active _ curFont familyName sameAs: fontName. ptMenu _ MenuMorph new defaultTarget: self. style pointSizes do:[:pt| (active and:[pt = curFont pointSize]) ifTrue:[label _ ''] ifFalse:[label _ '']. label _ label, pt printString, ' pt'. ptMenu add: label target: self selector: #fontSelectionNamed:pointSize: argumentList: {fontName. pt}. ]. active ifTrue:[label _ ''] ifFalse:[label _ '']. label _ label, fontName. fontMenu add: label subMenu: ptMenu "later - allow selecting the font only and keep font sizes intact" "target: self selector: #fontSelectionNamed: argumentList: {fontName}". ]. fontMenu popUpNoKeyboard.! !