Packages February 2010

packages@lists.squeakfoundation.org

2 participants
1083 discussions

The Trunk: Morphic-dtl.315.mcz
by commits＠source.squeak.org 01 Feb '10

01 Feb '10

David T. Lewis uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-dtl.315.mcz ==================== Summary ==================== Name: Morphic-dtl.315 Author: dtl Time: 31 January 2010, 9:07:08.899 pm UUID: 8b66934c-739d-4523-99a2-1617ef7e1312 Ancestors: Morphic-dtl.314, Morphic-ul.314 Merge Morphic-ul.314 and Morphic-dtl.314 =============== Diff against Morphic-dtl.314 =============== Item was changed: ----- Method: TextEditor>>selectionAsStream (in category 'accessing-selection') ----- selectionAsStream "Answer a ReadStream on the text in the paragraph that is currently selected." + ^ReadWriteStream + on: paragraph string + from: self startIndex + to: self stopIndex - 1! - ^ReadStream - on: (paragraph string copyFrom: self startIndex to: self stopIndex - 1)! Item was changed: ----- Method: SmalltalkEditor>>tallySelection (in category 'do-its') ----- tallySelection "Treat the current selection as an expression; evaluate it and return the time took for this evaluation" | result rcvr ctxt valueAsString v | self lineSelectAndEmptyCheck: [^ -1]. (model respondsTo: #doItReceiver) ifTrue: [FakeClassPool adopt: model selectedClass. "Include model pool vars if any" rcvr := model doItReceiver. ctxt := model doItContext] ifFalse: [rcvr := ctxt := nil]. result := [ | cm | cm := rcvr class evaluatorClass new compiledMethodFor: self selectionAsStream in: ctxt to: rcvr notifying: self ifFail: [FakeClassPool adopt: nil. ^ #failedDoit] logged: false. Time millisecondsToRun: + [v := cm valueWithReceiver: rcvr arguments: #() ]. - [v := cm valueWithReceiver: rcvr arguments: (Array with: ctxt)]. ] on: OutOfScopeNotification do: [ :ex | ex resume: true]. FakeClassPool adopt: nil. "We do not want to have large result displayed" valueAsString := v printString. (valueAsString size > 30) ifTrue: [valueAsString := (valueAsString copyFrom: 1 to: 30), '...']. PopUpMenu inform: 'Time to compile and execute: ', result printString, 'ms res: ', valueAsString. !

1 0

The Trunk: Morphic-dtl.315.mcz
by commits＠source.squeak.org 01 Feb '10

01 Feb '10

1 0

The Trunk: ST80-dtl.90.mcz
by commits＠source.squeak.org 01 Feb '10

01 Feb '10

David T. Lewis uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-dtl.90.mcz ==================== Summary ==================== Name: ST80-dtl.90 Author: dtl Time: 31 January 2010, 9:05:16.275 pm UUID: 8a2dc302-830b-4a7e-b319-3c40519bd779 Ancestors: ST80-dtl.89, ST80-ul.89 Merge ST80-dtl.89 and ST80-ul.89 =============== Diff against ST80-dtl.89 =============== Item was changed: ----- Method: ParagraphEditor>>tallySelection (in category 'do-its') ----- tallySelection "Treat the current selection as an expression; evaluate it and return the time took for this evaluation" | result rcvr ctxt valueAsString v | self lineSelectAndEmptyCheck: [^ -1]. (model respondsTo: #doItReceiver) ifTrue: [FakeClassPool adopt: model selectedClass. "Include model pool vars if any" rcvr := model doItReceiver. ctxt := model doItContext] ifFalse: [rcvr := ctxt := nil]. result := [ | cm | cm := rcvr class evaluatorClass new compiledMethodFor: self selectionAsStream in: ctxt to: rcvr notifying: self ifFail: [FakeClassPool adopt: nil. ^ #failedDoit] logged: false. Time millisecondsToRun: + [v := cm valueWithReceiver: rcvr arguments: #() ]. - [v := cm valueWithReceiver: rcvr arguments: (Array with: ctxt)]. ] on: OutOfScopeNotification do: [ :ex | ex resume: true]. FakeClassPool adopt: nil. "We do not want to have large result displayed" valueAsString := v printString. (valueAsString size > 30) ifTrue: [valueAsString := (valueAsString copyFrom: 1 to: 30), '...']. PopUpMenu inform: 'Time to compile and execute: ', result printString, 'ms res: ', valueAsString. !

1 0

The Trunk: ST80-dtl.90.mcz
by commits＠source.squeak.org 01 Feb '10

01 Feb '10

1 0

The Trunk: ST80-dtl.90.mcz
by commits＠source.squeak.org 01 Feb '10

01 Feb '10

1 0

The Trunk: System-dtl.241.mcz
by commits＠source.squeak.org 01 Feb '10

01 Feb '10

A new version of System was added to project The Trunk: http://source.squeak.org/trunk/System-dtl.241.mcz ==================== Summary ==================== Name: System-dtl.241 Author: dtl Time: 30 January 2010, 10:00:40.376 pm UUID: 4d4d420e-4618-4fe6-ab0f-c63a28bb622f Ancestors: System-dtl.240 Add Project>>dispatchTo:addPrefixAndSend:withArguments: Allow classes with MVC and Morphic dependencies to dispatch through Project current to invoke appropriate methods. Prevents accumulation of unrelated implementations in Project. =============== Diff against System-dtl.240 =============== Item was added: + ----- Method: Project>>dispatchTo:addPrefixAndSend:withArguments: (in category 'dispatching') ----- + dispatchTo: requestor addPrefixAndSend: baseSelector withArguments: arguments + "Sender wants to perform a method with dependencies on the type of project. + Dispatch to an appropriate method for the current project." + + | selector | + selector := (self selectorPrefixForDispatch, baseSelector) asSymbol. + ^ requestor perform: selector withArguments: arguments! Item was added: + ----- Method: Project>>selectorPrefixForDispatch (in category 'dispatching') ----- + selectorPrefixForDispatch + "A string to be preppended to selectors for project specific methods" + + ^ self subclassResponsibility!

1 0

The Trunk: System-dtl.241.mcz
by commits＠source.squeak.org 01 Feb '10

01 Feb '10

1 0

The Trunk: System-dtl.241.mcz
by commits＠source.squeak.org 01 Feb '10

01 Feb '10

1 0

The Trunk: Tools-dtl.165.mcz
by commits＠source.squeak.org 01 Feb '10

01 Feb '10

A new version of Tools was added to project The Trunk: http://source.squeak.org/trunk/Tools-dtl.165.mcz ==================== Summary ==================== Name: Tools-dtl.165 Author: dtl Time: 30 January 2010, 10:01:34.961 pm UUID: 376005ff-b046-4bfa-aaef-66ffb6f4d534 Ancestors: Tools-ar.164 Move PopUpMenu from ST80-Menus to Tools-Menus. Remove explicit MVC and Morphic dependencies from PopUpMenu. =============== Diff against Tools-ar.164 =============== Item was added: + ----- Method: PopUpMenu class>>notify: (in category 'dialogs') ----- + notify: message + "Deprecated. Use #inform: instead." + + self inform: message! Item was added: + ----- Method: PopUpMenu class>>initialize (in category 'class initialization') ----- + initialize "PopUpMenu initialize" + (MenuStyle := TextStyle default copy) + gridForFont: TextStyle default defaultFontIndex withLead: 0; + centered. + PopUpMenu allSubInstancesDo: [:m | m rescan]! Item was added: + ----- Method: PopUpMenu>>startUpLeftFlush (in category 'basic control sequence') ----- + startUpLeftFlush + "Build and invoke this menu with no initial selection. By Jerry Archibald, 4/01. + If in MVC, align menus items with the left margin. + Answer the selection associated with the menu item chosen by the user or nil if none is chosen. + The mechanism for getting left-flush appearance in mvc leaves a tiny possibility for misadventure: if the user, in mvc, puts up the jump-to-project menu, then hits cmd period while it is up, then puts up a second jump-to-project menu before dismissing or proceeding through the debugger, it's possible for mvc popup-menus thereafter to appear left-aligned rather than centered; this very unlikely condition can be cleared by evaluating 'PopUpMenu alignment: 2'" + + ^ Project current + dispatchTo: self + addPrefixAndSend: #StartUpLeftFlush + withArguments: #() + ! Item was added: + ----- Method: PopUpMenu>>markerOn: (in category 'marker adjustment') ----- + markerOn: aPoint + "The item whose bounding area contains aPoint should be marked as + selected. Highlight its area and set the selection to its index." + + selection = 0 | (marker containsPoint: aPoint) not + ifTrue: [selection = 0 & (marker containsPoint: aPoint) + ifTrue: [Display reverse: marker] + ifFalse: + [selection > 0 ifTrue: [Display reverse: marker]. + marker := + marker + align: marker topLeft + with: marker left @ (self markerTop: aPoint). + Display reverse: marker]]. + selection := marker top - frame top // marker height + 1! Item was changed: SystemOrganization addCategory: #'Tools-ArchiveViewer'! SystemOrganization addCategory: #'Tools-Base'! SystemOrganization addCategory: #'Tools-Browser'! SystemOrganization addCategory: #'Tools-Changes'! SystemOrganization addCategory: #'Tools-Debugger'! SystemOrganization addCategory: #'Tools-Explorer'! SystemOrganization addCategory: #'Tools-File Contents Browser'! SystemOrganization addCategory: #'Tools-FileList'! SystemOrganization addCategory: #'Tools-Inspector'! SystemOrganization addCategory: #'Tools-Process Browser'! + SystemOrganization addCategory: #'Tools-Menus'! Item was added: + ----- Method: PopUpMenu>>markerTop: (in category 'marker adjustment') ----- + markerTop: aPoint + "Answer aPoint, gridded to lines in the receiver." + + ^(aPoint y - frame inside top truncateTo: font height) + frame inside top! Item was added: + ----- Method: PopUpMenu class>>labelArray: (in category 'instance creation') ----- + labelArray: labelArray + "Answer an instance of me whose items are in labelArray." + + ^ self labelArray: labelArray lines: nil! Item was added: + ----- Method: PopUpMenu>>computeLabelParagraph (in category 'private') ----- + computeLabelParagraph + "Answer a Paragraph containing this menu's labels, one per line and centered." + + ^ Paragraph withText: labelString asText style: MenuStyle! Item was added: + ----- Method: PopUpMenu>>displayAt:withCaption:during: (in category 'displaying') ----- + displayAt: aPoint withCaption: captionOrNil during: aBlock + "Display the receiver just to the right of aPoint while aBlock is evaluated. If the receiver is forced off screen, display it just to the right." + | delta savedArea captionForm captionSave outerFrame captionText tFrame frameSaveLoc captionBox | + marker ifNil: [self computeForm]. + frame := frame align: marker leftCenter with: aPoint + (2@0). + outerFrame := frame. + captionOrNil notNil ifTrue: + [captionText := (DisplayText + text: captionOrNil asText + textStyle: MenuStyle copy centered) + foregroundColor: Color black + backgroundColor: Color white. + tFrame := captionText boundingBox insetBy: -2. + outerFrame := frame merge: (tFrame align: tFrame bottomCenter + with: frame topCenter + (0@2))]. + delta := outerFrame amountToTranslateWithin: Display boundingBox. + frame right > Display boundingBox right + ifTrue: [delta := 0 - frame width @ delta y]. + frame := frame translateBy: delta. + captionOrNil notNil ifTrue: + [captionForm := captionText form. + captionBox := captionForm boundingBox expandBy: 4. + captionBox := captionBox align: captionBox bottomCenter + with: frame topCenter + (0@2). + captionSave := Form fromDisplay: captionBox. + Display border: captionBox width: 4 fillColor: Color white. + Display border: captionBox width: 2 fillColor: Color black. + captionForm displayAt: captionBox topLeft + 4]. + marker := marker align: marker leftCenter with: aPoint + delta + (2@0). + savedArea := Form fromDisplay: frame. + self menuForm displayOn: Display at: (frameSaveLoc := frame topLeft). + selection ~= 0 ifTrue: [Display reverse: marker]. + Cursor normal showWhile: [aBlock value]. + savedArea displayOn: Display at: frameSaveLoc. + captionOrNil notNil ifTrue: + [captionSave displayOn: Display at: captionBox topLeft]! Item was added: + ----- Method: PopUpMenu>>controlActivity (in category 'basic control sequence') ----- + controlActivity + "Do whatever a menu must do - now with keyboard support." + + | didNotMove downPos | + didNotMove := true. + Sensor anyButtonPressed + ifFalse: + [didNotMove := false. + Sensor waitButtonOrKeyboard]. + + Sensor keyboardPressed ifFalse: [self manageMarker]. + (didNotMove and: [selection = 0]) + ifTrue: + [downPos := Sensor cursorPoint. + [didNotMove and: [Sensor anyButtonPressed]] + whileTrue: + [(downPos dist: Sensor cursorPoint) < 2 ifFalse: [didNotMove := false]]. + didNotMove ifTrue: [Sensor waitButtonOrKeyboard]]. + + [Sensor keyboardPressed] whileTrue: + [self readKeyboard ifTrue: [^ self]. + Sensor waitButtonOrKeyboard]. + + [Sensor anyButtonPressed] whileTrue: [self manageMarker]! Item was added: + ----- Method: PopUpMenu>>labelString (in category 'accessing') ----- + labelString + ^ labelString! Item was added: + Object subclass: #PopUpMenu + instanceVariableNames: 'labelString font lineArray frame form marker selection' + classVariableNames: 'CacheMenuForms MenuStyle' + poolDictionaries: '' + category: 'Tools-Menus'! + + !PopUpMenu commentStamp: '<historical>' prior: 0! + I represent a list of items. My instances are presented on the display screen in a rectangular area. The user points to an item, pressing a mouse button; the item is highlighted. When the button is released, the highlighted item indicates the selection.! Item was added: + ----- Method: PopUpMenu>>readKeyboard (in category 'basic control sequence') ----- + readKeyboard + "Keyboard support for menus. ESC will abort the menu, Space or CR + will select an item. Cursor up and cursor down will change the + selection. Any other key will either select an item whose label starts + with that character or select the next matching label. + Answer true if the menu should be closed and false otherwise." + + | ch labels occurences | + ch := Sensor keyboard asciiValue. + (ch = 13 or: [ch = 32]) ifTrue: [^ true]. + ch = 27 ifTrue: [self setSelection: 0. ^ true]. + ch = 30 + ifTrue: + [self setSelection: (selection <= 1 + ifTrue: [self nItems] + ifFalse: [selection - 1])]. + ch = 31 ifTrue: [self setSelection: selection \\ self nItems + 1]. + ch := ch asCharacter asLowercase. + labels := labelString findTokens: Character cr asString. + occurences := 0. + 1 + selection to: selection + labels size do: + [:index | + | i | i := index - 1 \\ labels size + 1. + (labels at: i) withBlanksTrimmed first asLowercase = ch + ifTrue: [(occurences := occurences + 1) = 1 ifTrue: [self setSelection: i]]]. + ^ occurences = 1! Item was added: + ----- Method: PopUpMenu class>>labelArray:lines: (in category 'instance creation') ----- + labelArray: labelArray lines: lineArray + "Answer an instance of me whose items are in labelArray, with lines + drawn after each item indexed by anArray. 2/1/96 sw" + + labelArray isEmpty ifTrue: [self error: 'Menu must not be zero size']. + ^ self + labels: (String streamContents: + [:stream | + labelArray do: [:each | stream nextPutAll: each; cr]. + stream skip: -1 "remove last CR"]) + lines: lineArray + + "Example: + (PopUpMenu labelArray: #('frog' 'and' 'toad') lines: #()) startUp"! Item was added: + ----- Method: PopUpMenu>>startUpCenteredWithCaption: (in category 'basic control sequence') ----- + startUpCenteredWithCaption: captionOrNil + "Differs from startUpWithCaption: by appearing with cursor in the menu, + and thus ready to act on mouseUp, without requiring user tweak to confirm" + ^ self startUpWithCaption: captionOrNil at: (ActiveHand ifNil:[Sensor]) cursorPoint - (20@0)! Item was added: + ----- Method: PopUpMenu>>startUpWithCaption:icon:at: (in category 'basic control sequence') ----- + startUpWithCaption: captionOrNil icon: aForm 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 + icon: aForm + at: location + allowKeyboard: Preferences menuKeyboardControl + ! Item was added: + ----- Method: PopUpMenu class>>alignment (in category 'class initialization') ----- + alignment + + ^ MenuStyle alignment! Item was added: + ----- Method: PopUpMenu>>frameHeight (in category 'accessing') ----- + frameHeight + "Designed to avoid the entire frame computation (includes MVC form), + since the menu may well end up being displayed in Morphic anyway." + | nItems | + frame ifNotNil: [^ frame height]. + nItems := 1 + (labelString occurrencesOf: Character cr). + ^ (nItems * MenuStyle lineGrid) + 4 "border width"! Item was added: + ----- Method: PopUpMenu>>startUpWithCaption:icon: (in category 'basic control sequence') ----- + startUpWithCaption: captionOrNil icon: aForm + "Display the menu, slightly offset from the cursor, + so that a slight tweak is required to confirm any action." + ^ self + startUpWithCaption: captionOrNil + icon: aForm + at: (ActiveHand ifNil:[Sensor]) cursorPoint + ! Item was added: + ----- Method: PopUpMenu class>>leftFlush (in category 'class initialization') ----- + leftFlush + + MenuStyle leftFlush! Item was added: + ----- Method: PopUpMenu class>>withCaption:chooseFrom: (in category 'instance creation') ----- + withCaption: cap chooseFrom: labels + "Simply put up a menu. Get the args in the right order with the caption + first. labels may be either an array of items or a string with CRs in it. + May use backslashes for returns." + + ^ (labels isString + ifTrue: [self labels: labels withCRs lines: nil] + ifFalse: [self labelArray: labels lines: nil]) + startUpWithCaption: cap withCRs! Item was added: + ----- Method: PopUpMenu>>computeForm (in category 'private') ----- + computeForm + "Compute and answer a Form to be displayed for this menu." + + | borderInset paraForm menuForm inside | + borderInset := 4@4. + paraForm := (DisplayText text: labelString asText textStyle: MenuStyle) form. + menuForm := Form extent: paraForm extent + (borderInset * 2) depth: paraForm depth. + menuForm fill: (0 @ 0 extent: menuForm extent) + rule: Form over + fillColor: Color white. + menuForm borderWidth: 2. + paraForm displayOn: menuForm at: borderInset. + lineArray == nil ifFalse: + [lineArray do: + [ :line | + menuForm fillBlack: (4 @ ((line * font height) + borderInset y) + extent: (menuForm width - 8 @ 1))]]. + + frame := Quadrangle new. + frame region: menuForm boundingBox. + frame borderWidth: 4. + inside := frame inside. + marker := inside topLeft extent: (inside width @ MenuStyle lineGrid). + selection := 1. + + ^ form := menuForm + ! Item was added: + ----- Method: PopUpMenu>>rescan (in category 'private') ----- + rescan + "Cause my form to be recomputed after a font change." + + labelString == nil ifTrue: [labelString := 'NoText!!']. + self labels: labelString font: (MenuStyle fontAt: 1) lines: lineArray. + frame := marker := form := nil. + + "PopUpMenu allSubInstancesDo: [:m | m rescan]"! Item was added: + ----- Method: PopUpMenu class>>inform: (in category 'dialogs') ----- + inform: aString + "PopUpMenu inform: 'I like Squeak'" + + | iconOrNil | + iconOrNil := (Smalltalk at: #MenuIcons ifAbsent: []) ifNotNilDo: [:cls | cls confirmIcon]. + (PopUpMenu labels: ' OK ' translated) + startUpWithCaption: aString + icon: iconOrNil + ! Item was added: + ----- Method: PopUpMenu>>lineArray (in category 'accessing') ----- + lineArray + ^ lineArray! Item was added: + ----- Method: PopUpMenu>>startUpSegmented:withCaption:at: (in category 'basic control sequence') ----- + startUpSegmented: segmentHeight withCaption: captionOrNil at: location + "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." + " + (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...' translated] ifFalse: ['more...' translated]) + 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. + index = 1 + ifTrue: [from := to + 1. + from > nLines ifTrue: [ from := 1 ]] + ifFalse: [index = 0 ifTrue: [^ 0]. + ^ from + index - 2]]! Item was added: + ----- Method: PopUpMenu>>center (in category 'accessing') ----- + center + "Answer the point at the center of the receiver's rectangular area." + + ^ frame center! Item was added: + ----- Method: PopUpMenu>>markerOff (in category 'marker adjustment') ----- + markerOff + "No item is selected. Reverse the highlight if any item has been marked + as selected." + + self setSelection: 0! Item was added: + ----- Method: PopUpMenu class>>alignment: (in category 'class initialization') ----- + alignment: anAlignment + + ^ MenuStyle alignment: anAlignment! Item was added: + ----- Method: PopUpMenu>>startUp (in category 'basic control sequence') ----- + startUp + "Display and make a selection from the receiver as long as the button + is pressed. Answer the current selection." + + ^ self startUpWithCaption: nil! Item was added: + ----- Method: PopUpMenu>>startUpWithCaption:at: (in category 'basic control sequence') ----- + 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: Preferences menuKeyboardControl! Item was added: + ----- Method: PopUpMenu>>menuForm (in category 'private') ----- + menuForm + "Answer a Form to be displayed for this menu." + + form == nil ifTrue: [self computeForm]. + ^ form! Item was added: + ----- Method: PopUpMenu>>manageMarker (in category 'marker adjustment') ----- + manageMarker + "If the cursor is inside the receiver's frame, then highlight the marked + item. Otherwise no item is to be marked." + | pt | + "Don't let pt get far from display box, so scrolling will go all the way" + pt := Sensor cursorPoint adhereTo: (Display boundingBox expandBy: 1). + (frame inside containsPoint: pt) + ifTrue: ["Need to cache the form for reasonable scrolling performance" + ((Display boundingBox insetBy: 0@3) containsPoint: pt) + ifFalse: [pt := pt - (self scrollIntoView: pt)]. + self markerOn: pt] + ifFalse: [self markerOff]! Item was added: + ----- Method: PopUpMenu>>startUpWithCaption: (in category 'basic control sequence') ----- + startUpWithCaption: captionOrNil + "Display the menu, slightly offset from the cursor, + so that a slight tweak is required to confirm any action." + ^ self startUpWithCaption: captionOrNil at: (ActiveHand ifNil:[Sensor]) cursorPoint! Item was added: + ----- Method: PopUpMenu>>startUpWithCaption:icon:at:allowKeyboard: (in category 'basic control sequence') ----- + startUpWithCaption: captionOrNil icon: aForm 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 | + (ProvideAnswerNotification signal: captionOrNil) ifNotNil: + [:answer | ^ selection := answer ifTrue: [1] ifFalse: [2]]. + + maxHeight := Display height*3//4. + self frameHeight > maxHeight ifTrue: + [^ self + startUpSegmented: maxHeight + withCaption: captionOrNil + at: location + allowKeyboard: aBoolean]. + + ^ Project current + dispatchTo: self + addPrefixAndSend: #StartUpWithCaption:icon:at:allowKeyboard: + withArguments: {captionOrNil. aForm. location. aBoolean}! Item was added: + ----- Method: PopUpMenu>>startUpSegmented:withCaption:at:allowKeyboard: (in category 'basic control sequence') ----- + 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...' translated] ifFalse: ['more...' translated]) + 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]]! Item was added: + ----- Method: PopUpMenu>>selection (in category 'selecting') ----- + selection + "Answer the current selection." + + ^ selection! Item was added: + ----- Method: PopUpMenu>>startUpWithoutKeyboard (in category 'basic control sequence') ----- + 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! Item was added: + ----- Method: PopUpMenu class>>labels:lines: (in category 'instance creation') ----- + labels: aString lines: anArray + "Answer an instance of me whose items are in aString, with lines drawn + after each item indexed by anArray." + + ^ self new + labels: aString + font: MenuStyle defaultFont + lines: anArray! Item was added: + ----- Method: PopUpMenu>>startUpWithCaption:at:allowKeyboard: (in category 'basic control sequence') ----- + 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." + + ^ self + startUpWithCaption: captionOrNil + icon: nil + at: location + allowKeyboard: aBoolean! Item was added: + ----- Method: PopUpMenu>>nItems (in category 'accessing') ----- + nItems + ^ (labelString occurrencesOf: Character cr) + 1! Item was added: + ----- Method: PopUpMenu>>scrollIntoView: (in category 'marker adjustment') ----- + scrollIntoView: cursorLoc + | dy | + dy := 0. + cursorLoc y < 2 ifTrue: [dy := font height]. + cursorLoc y > (Display height-3) ifTrue: [dy := font height negated]. + dy = 0 ifTrue: [^ 0@0]. + self markerOff. + frame := frame translateBy: 0@dy. + marker := marker translateBy: 0@dy. + self menuForm displayOn: Display at: frame topLeft. + ^ 0@dy! Item was added: + ----- Method: PopUpMenu>>setSelection: (in category 'selecting') ----- + setSelection: index + | newSelection | + selection = index ifTrue: [^ self]. + newSelection := (0 max: index) min: frame height // marker height. + selection > 0 ifTrue: [Display reverse: marker]. + marker := marker translateBy: 0 @ (newSelection - selection * marker height). + selection := newSelection. + selection > 0 ifTrue: [Display reverse: marker]! Item was added: + ----- Method: PopUpMenu class>>confirm: (in category 'dialogs') ----- + confirm: queryString + "Put up a yes/no menu with caption queryString. Answer true if the + response is yes, false if no. This is a modal question--the user must + respond yes or no." + + "PopUpMenu confirm: 'Are you hungry?'" + + ^ self confirm: queryString trueChoice: 'Yes' translated falseChoice: 'No' translated! Item was added: + ----- Method: PopUpMenu class>>setMenuFontTo: (in category 'class initialization') ----- + setMenuFontTo: aFont + "Set the menu font as indicated" + + MenuStyle := TextStyle fontArray: { aFont }. + MenuStyle + gridForFont: 1 withLead: 0; + centered. + self allSubInstancesDo: [:m | m rescan]! Item was added: + ----- Method: PopUpMenu class>>confirm:orCancel: (in category 'dialogs') ----- + confirm: queryString orCancel: cancelBlock + "Put up a yes/no/cancel menu with caption aString. Answer + true if + the response is yes, false if no. If cancel is chosen, evaluate + cancelBlock. This is a modal question--the user must respond + yes or no." + "PopUpMenu confirm: 'Reboot universe' orCancel: + [^'Nevermind'] " + | menu choice | + menu := PopUpMenu labelArray: {'Yes' translated. 'No' translated. 'Cancel' translated}. + choice := menu startUpWithCaption: queryString icon: MenuIcons confirmIcon. + choice = 1 + ifTrue: [^ true]. + choice = 2 + ifTrue: [^ false]. + ^ cancelBlock value! Item was added: + ----- Method: PopUpMenu class>>labels: (in category 'instance creation') ----- + labels: aString + "Answer an instance of me whose items are in aString." + + ^ self labels: aString lines: nil! Item was added: + ----- Method: PopUpMenu>>labels:font:lines: (in category 'private') ----- + labels: aString font: aFont lines: anArray + + labelString := aString. + font := aFont. + lineArray := anArray. + ! Item was added: + ----- Method: PopUpMenu class>>confirm:trueChoice:falseChoice: (in category 'dialogs') ----- + confirm: queryString trueChoice: trueChoice falseChoice: falseChoice + "Put up a yes/no menu with caption queryString. The actual + wording + for the two choices will be as provided in the trueChoice and + falseChoice parameters. Answer true if the response is the + true-choice, + false if it's the false-choice. + This is a modal question -- the user must respond one way or + the other." + "PopUpMenu + confirm: 'Are you hungry?' + trueChoice: 'yes, I''m famished' + falseChoice: 'no, I just ate'" + | menu choice | + menu := PopUpMenu labelArray: {trueChoice. falseChoice}. + [(choice := menu startUpWithCaption: queryString icon: MenuIcons confirmIcon) isNil] whileTrue. + ^ choice = 1!

1 0

The Trunk: Tools-dtl.165.mcz
by commits＠source.squeak.org 01 Feb '10

01 Feb '10

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages February 2010