The Trunk: ST80-dtl.94.mcz

David T. Lewis uploaded a new version of ST80 to project The Trunk:
http://source.squeak.org/trunk/ST80-dtl.94.mcz

==================== Summary ====================

Name: ST80-dtl.94
Author: dtl
Time: 6 February 2010, 10:31:16.332 pm
UUID: afe56d11-78da-4f42-a37e-19677a6f83ae
Ancestors: ST80-dtl.93

Move SelectionMenu, CustomMenu, and EmphasizedMenu from ST80-Menus to Tools-Menus. These classes are not MVC specific.

=============== Diff against ST80-dtl.93 ===============

Item was removed:
- ----- Method: CustomMenu>>arguments (in category 'compatibility') -----
- arguments
- "Answer my arguments, initializing them to an empty collection if they're found to be nil."
-
- ^ arguments ifNil: [arguments := OrderedCollection new]!

Item was removed:
- ----- Method: CustomMenu>>initialize (in category 'initialize-release') -----
- initialize
-
- labels := OrderedCollection new.
- selections := OrderedCollection new.
- dividers := OrderedCollection new.
- lastDivider := 0.
- targets := OrderedCollection new.
- arguments := OrderedCollection new !

Item was removed:
- ----- Method: EmphasizedMenu>>setEmphasis (in category 'private') -----
- setEmphasis
- "Set up the receiver to reflect the emphases in the emphases array.  "
-
- | selStart selEnd currEmphasis |
-
- labelString := labelString asText.
- emphases isEmptyOrNil ifTrue: [^ self].
- selStart := 1.
- 1 to: selections size do:
- [:line |
- selEnd := selStart + (selections at: line) size - 1.
- ((currEmphasis := emphases at: line) size > 0 and: [currEmphasis ~~ #normal]) ifTrue:
- [labelString addAttribute: (TextEmphasis perform: currEmphasis)
- from: selStart to: selEnd].
- selStart := selEnd + 2]!

Item was removed:
- ----- Method: CustomMenu>>title: (in category 'initialize-release') -----
- title: aTitle
- title := aTitle!

Item was removed:
- ----- Method: SelectionMenu class>>labels:selections: (in category 'instance creation') -----
- labels: labels selections: selectionsArray
- "Answer an instance of me whose items are in labels, recording
- the given array of selections corresponding to the items in labels."
-
- ^ self
- labels: labels
- lines: #()
- selections: selectionsArray!

Item was removed:
- ----- Method: CustomMenu>>add:action: (in category 'construction') -----
- add: aString action: actionItem
- "Add the given string as the next menu item. If it is selected, the given action (usually but not necessarily a symbol) will be returned to the client."
-
- | s |
- aString ifNil: [^ self addLine].
- s := String new: aString size + 2.
- s at: 1 put: Character space.
- s replaceFrom: 2 to: s size - 1 with: aString.
- s at: s size put: Character space.
- labels addLast: s.
- selections addLast: actionItem.!

Item was removed:
- ----- Method: CustomMenu>>build (in category 'private') -----
- build
- "Turn myself into an invokable ActionMenu."
-
- | stream |
- stream := WriteStream on: (String new).
- labels do: [:label | stream nextPutAll: label; cr].
- (labels isEmpty) ifFalse: [stream skip: -1].  "remove final cr"
- super labels: stream contents
- font: MenuStyle defaultFont
- lines: dividers!

Item was removed:
- ----- Method: SelectionMenu class>>selections:lines: (in category 'instance creation') -----
- selections: selectionsArray lines: linesArray
- "Answer an instance of me whose labels and selections are identical."
-
- ^ self
- labelList: (selectionsArray collect: [:each | each asString])
- lines: linesArray
- selections: selectionsArray!

Item was removed:
- ----- Method: EmphasizedMenu>>emphases: (in category 'emphasis') -----
- emphases: emphasisArray
- emphases := emphasisArray!

Item was removed:
- ----- Method: SelectionMenu class>>labelList:lines: (in category 'instance creation') -----
- labelList: labelList lines: lines
- ^ self labelArray: labelList lines: lines!

Item was removed:
- ----- Method: CustomMenu>>invokeOn:orSendTo: (in category 'invocation') -----
- invokeOn: targetObject orSendTo: anObject
- "Pop up this menu and return the result of sending to the target object the selector corresponding to the menu item selected by the user. Return  nil if no item is selected.  If the chosen selector has arguments, obtain appropriately.  If the recipient does not respond to the resulting message, send it to the alternate object provided"
-
- | aSelector anIndex recipient |
- ^ (aSelector := self startUp) ifNotNil:
- [anIndex := self selection.
- recipient := ((targets := self targets) isEmptyOrNil or: [anIndex > targets size])
- ifTrue:
- [targetObject]
- ifFalse:
- [targets at: anIndex].
- aSelector numArgs == 0
- ifTrue:
- [recipient perform: aSelector orSendTo: anObject]
- ifFalse:
- [recipient perform: aSelector withArguments: (self arguments at: anIndex)]]!

Item was removed:
- ----- Method: CustomMenu>>labels:lines:selections: (in category 'construction') -----
- labels: labelList lines: linesArray selections: selectionsArray
- "This method allows the receiver to accept old-style SelectionMenu creation messages. It should be used only for backward compatibility during the MVC-to-Morphic transition. New code should be written using the other menu construction protocol such as addList:."
- "Labels can be either a sting with embedded crs, or a collection of strings."
-
- | labelArray |
- labelList isString
- ifTrue: [labelArray := labelList findTokens: String cr]
- ifFalse: [labelArray := labelList].
- 1 to: labelArray size do: [:i |
- self add: (labelArray at: i) action: (selectionsArray at: i).
- (linesArray includes: i) ifTrue: [self addLine]].
- !

Item was removed:
- SelectionMenu subclass: #EmphasizedMenu
- instanceVariableNames: 'emphases'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'ST80-Menus'!
-
- !EmphasizedMenu commentStamp: '<historical>' prior: 0!
- A selection menu in which individual selections are allowed to have different emphases.  Emphases allowed are: bold, italic, struckThrough, and plain.  Provide an emphasis array, with one element per selection, to use.  Refer to the class method #example.!

Item was removed:
- ----- Method: EmphasizedMenu class>>example3 (in category 'examples') -----
- example3
- "EmphasizedMenu example3"
-
- ^ (self
- selectionAndEmphasisPairs: #('how' #bold 'well' #normal 'does' #italic 'this' #struckOut 'work' #normal))
- startUpWithCaption: 'A Menu with Emphases'!

Item was removed:
- ----- Method: EmphasizedMenu>>startUpWithCaption: (in category 'display') -----
- startUpWithCaption: captionOrNil
- self setEmphasis.
- ^ super startUpWithCaption: captionOrNil!

Item was removed:
- ----- Method: EmphasizedMenu>>onlyBoldItem: (in category 'emphasis') -----
- onlyBoldItem: itemNumber
- "Set up emphasis such that all items are plain except for the given item number.  "
-
- emphases := (Array new: selections size) atAllPut: #normal.
- emphases at: itemNumber put: #bold!

Item was removed:
- ----- Method: SelectionMenu>>invokeOn:orSendTo: (in category 'invocation') -----
- invokeOn: targetObject orSendTo: anObject
- "Pop up the receiver, obtaining a selector; return the result of having the target object perform the selector.  If it dos not understand the selector, give the alternate object a chance"
-
- | aSelector |
- ^ (aSelector := self startUp) ifNotNil:
- [(targetObject respondsTo: aSelector)
- ifTrue:
- [targetObject perform: aSelector]
- ifFalse:
- [anObject perform: aSelector]]!

Item was removed:
- ----- Method: CustomMenu>>add:target:selector:argument: (in category 'compatibility') -----
- add: aString target: target selector: aSymbol argument: arg
- "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given argument."
-
- self add: aString
- target: target
- selector: aSymbol
- argumentList: (Array with: arg)!

Item was removed:
- ----- Method: CustomMenu>>addLine (in category 'construction') -----
- addLine
- "Append a line to the menu after the last entry. Suppress duplicate lines."
-
- (lastDivider ~= selections size) ifTrue: [
- lastDivider := selections size.
- dividers addLast: lastDivider].!

Item was removed:
- ----- Method: CustomMenu>>addStayUpItem (in category 'construction') -----
- addStayUpItem
- "For compatibility with MenuMorph.  Here it is a no-op"!

Item was removed:
- ----- Method: CustomMenu>>targets (in category 'compatibility') -----
- targets
- "Answer my targets, initializing them to an empty collection if found to be nil"
-
- ^ targets ifNil: [targets := OrderedCollection new]!

Item was removed:
- ----- Method: EmphasizedMenu class>>selections:emphases: (in category 'instance creation') -----
- selections: selList emphases: emphList
- "Answer an instance of the receiver with the given selections and
- emphases."
-
- ^ (self selections: selList) emphases: emphList
-
- "Example:
- (EmphasizedMenu
- selections: #('how' 'well' 'does' 'this' 'work?')
- emphases: #(bold plain italic struckOut plain)) startUp"!

Item was removed:
- ----- Method: CustomMenu>>balloonTextForLastItem: (in category 'construction') -----
- balloonTextForLastItem: aString
- "Vacuous backstop provided for compatibility with MorphicMenu"!

Item was removed:
- ----- Method: CustomMenu>>addServices2:for:extraLines: (in category 'compatibility') -----
- addServices2: services for: served extraLines: linesArray
-
- services withIndexDo: [:service :i |
- service addServiceFor: served toMenu: self.
- (linesArray includes: i)  ifTrue: [self addLine] ]!

Item was removed:
- ----- Method: CustomMenu>>labels:font:lines: (in category 'construction') -----
- labels: aString font: aFont lines: anArrayOrNil
- "This method allows the receiver to accept old-style SelectionMenu creation messages. It should be used only for backward compatibility during the MVC-to-Morphic transition. New code should be written using the other menu construction protocol such as addList:."
-
- | labelList linesArray |
- labelList := (aString findTokens: String cr) asArray.
- anArrayOrNil
- ifNil: [linesArray := #()]
- ifNotNil: [linesArray := anArrayOrNil].
- 1 to: labelList size do: [:i |
- self add: (labelList at: i) action: (labelList at: i).
- (linesArray includes: i) ifTrue: [self addLine]].
- font ifNotNil: [font := aFont].
- !

Item was removed:
- ----- Method: CustomMenu>>addList: (in category 'construction') -----
- addList: listOfTuplesAndDashes
- "Add a menu item to the receiver for each tuple in the given list of the form (<what to show> <selector>). Add a line for each dash (-) in the list.  The tuples may have an optional third element, providing balloon help for the item, but such an element is ignored in mvc."
-
- listOfTuplesAndDashes do: [:aTuple |
- aTuple == #-
- ifTrue: [self addLine]
- ifFalse: [self add: aTuple first action: aTuple second]]
-
- "CustomMenu new addList: #(
- ('apples' buyApples)
- ('oranges' buyOranges)
- -
- ('milk' buyMilk)); startUp"
-
- !

Item was removed:
- ----- Method: CustomMenu>>addServices:for:extraLines: (in category 'compatibility') -----
- addServices: services for: served extraLines: linesArray
-
- services withIndexDo: [:service :i |
- self addService: service for: served.
- (linesArray includes: i) | service useLineAfter
- ifTrue: [self addLine]]!

Item was removed:
- ----- Method: SelectionMenu class>>labelList: (in category 'instance creation') -----
- labelList: labelList
- ^ self labelArray: labelList!

Item was removed:
- ----- Method: SelectionMenu class>>fromArray: (in category 'instance creation') -----
- fromArray: anArray
- "Construct a menu from anArray.  The elements of anArray must be either:
- *  A pair of the form: <label> <selector>
- or *  The 'dash' (or 'minus sign') symbol
-
- Refer to the example at the bottom of the method"
-
- | labelList lines selections anIndex |
- labelList := OrderedCollection new.
- lines := OrderedCollection new.
- selections := OrderedCollection new.
- anIndex := 0.
- anArray do:
- [:anElement |
- anElement size == 1
- ifTrue:
- [(anElement == #-) ifFalse: [self error: 'badly-formed menu constructor'].
- lines add: anIndex]
- ifFalse:
- [anElement size == 2 ifFalse: [self error: 'badly-formed menu constructor'].
- anIndex := anIndex + 1.
- labelList add: anElement first.
- selections add: anElement second]].
- ^ self labelList: labelList lines: lines selections: selections
-
- "(SelectionMenu fromArray:
- #( ('first label' moja)
- ('second label' mbili)
- -
- ('third label' tatu)
- -
- ('fourth label' nne)
- ('fifth label' tano))) startUp"!

Item was removed:
- ----- Method: CustomMenu>>invokeOn:defaultSelection: (in category 'invocation') -----
- invokeOn: targetObject defaultSelection: defaultSelection
- "Invoke the menu with the given default selection (i.e. one of my 'action' symbols). Answer the 'action' selector associated with the menu item chosen by the user or nil if none is chosen."
-
- | sel |
- sel := self startUp: defaultSelection.
- sel = nil ifFalse: [
- sel numArgs = 0
- ifTrue: [^ targetObject perform: sel]
- ifFalse: [^ targetObject perform: sel with: nil]].
- ^ nil
- !

Item was removed:
- ----- Method: SelectionMenu class>>labels:lines: (in category 'instance creation') -----
- labels: labels lines: linesArray
- "Answer an instance of me whose items are in labels, with lines drawn  
- after each item indexed by linesArray. Labels can be either a string
- with embedded CRs, or a collection of strings."
-
- (labels isString)
- ifTrue: [^ super labels: labels lines: linesArray]
- ifFalse: [^ super labelArray: labels lines: linesArray]!

Item was removed:
- ----- Method: SelectionMenu class>>labelList:selections: (in category 'instance creation') -----
- labelList: labelList selections: selections
- ^ self
- labelList: labelList
- lines: #()
- selections: selections!

Item was removed:
- ----- Method: EmphasizedMenu class>>example1 (in category 'examples') -----
- example1
- "EmphasizedMenu example1"
-
- ^ (self
- selections: #('how' 'well' 'does' 'this' 'work?' )
- emphases: #(#bold #normal #italic #struckOut #normal ))
- startUpWithCaption: 'A Menu with Emphases'!

Item was removed:
- SelectionMenu subclass: #CustomMenu
- instanceVariableNames: 'labels dividers lastDivider title targets arguments'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'ST80-Menus'!
-
- !CustomMenu commentStamp: '<historical>' prior: 0!
- I am used to build menus on-the-fly. I maintain lists of menu items, actions (usually symbols to be sent as messages), and menu section dividing lines to which my clients may append new entries and lines by sending me the messages:
-
- add: aString action: anAction
- addLine
-
- After the menu is constructed, it may be invoked with one of the following messages:
-
- startUp: initialSelection
- startUp
-
- I am a subclass of ActionMenu, so I inherit a number of instance variables. The ones I am particularly concerned with are:
-
- items _ an OrderedCollection of strings to appear in the menu
- selectors _ an OrderedCollection of Symbols to be used as message selectors
- lineArray _ an OrderedCollection of line positions
- lastLine _ used to keep track of the last line to avoid making duplicate entries in lineArray!

Item was removed:
- ----- Method: CustomMenu>>addTranslatedList: (in category 'construction') -----
- addTranslatedList: listOfTuplesAndDashes
- "Add a menu item to the receiver for each tuple in the given list of the form (<what to show> <selector>). Add a line for each dash (-) in the list.  The tuples may have an optional third element, providing balloon help for the item, but such an element is ignored in mvc.
- The first element will be translated."
-
- listOfTuplesAndDashes do: [:aTuple |
- aTuple == #-
- ifTrue: [self addLine]
- ifFalse: [self add: aTuple first translated action: aTuple second]]
-
- "CustomMenu new addTranslatedList: #(
- ('apples' buyApples)
- ('oranges' buyOranges)
- -
- ('milk' buyMilk)); startUp"
-
- !

Item was removed:
- ----- Method: CustomMenu>>add:subMenu:target:selector:argumentList: (in category 'compatibility') -----
- add: aString subMenu: aMenu target: target selector: aSymbol argumentList: argList
- "Create a sub-menu with the given label. This isn't really a sub-menu the way Morphic does it; it'll just pop up another menu."
-
- self
- add: aString
- target: aMenu
- selector: #invokeOn:
- argumentList: argList asArray.!

Item was removed:
- ----- Method: SelectionMenu>>startUpWithCaption:at:allowKeyboard: (in category 'basic control sequence') -----
- 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!

Item was removed:
- ----- Method: CustomMenu>>startUp: (in category 'invocation') -----
- startUp: initialSelection
- "Build and invoke this menu with the given initial selection. Answer the selection associated with the menu item chosen by the user or nil if none is chosen."
-
- ^ self startUp: initialSelection withCaption: title!

Item was removed:
- ----- Method: SelectionMenu>>selections: (in category 'accessing') -----
- selections: selectionArray
- selections := selectionArray!

Item was removed:
- ----- Method: CustomMenu>>addService:for: (in category 'compatibility') -----
- addService: aService for: serviceUser
- "Append a menu item with the given service. If the item is selected, it will perform the given service."
-
- aService addServiceFor: serviceUser toMenu: self.!

Item was removed:
- ----- Method: CustomMenu>>invokeOn: (in category 'invocation') -----
- invokeOn: targetObject
- "Pop up this menu and return the result of sending to the target object the selector corresponding to the menu item selected by the user. Return nil if no item is selected.  If the chosen selector has arguments, obtain them from my arguments"
-
- ^ self invokeOn: targetObject orSendTo: nil!

Item was removed:
- ----- Method: SelectionMenu class>>labelList:lines:selections: (in category 'instance creation') -----
- labelList: labelList lines: lines selections: selections
- ^ (self labelArray: labelList lines: lines) selections: selections!

Item was removed:
- PopUpMenu subclass: #SelectionMenu
- instanceVariableNames: 'selections'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'ST80-Menus'!

Item was removed:
- ----- Method: CustomMenu class>>example (in category 'example') -----
- example
- "CustomMenu example"
-
- | menu |
- menu := CustomMenu new.
- menu add: 'apples' action: #apples.
- menu add: 'oranges' action: #oranges.
- menu addLine.
- menu addLine.  "extra lines ignored"
- menu add: 'peaches' action: #peaches.
- menu addLine.
- menu add: 'pears' action: #pears.
- menu addLine.
- ^ menu startUp: #apples
-
-
- "NB:  The following is equivalent to the above, but uses the compact #fromArray: consruct:
- (CustomMenu fromArray:
- #( ('apples' apples)
- ('oranges' oranges)
- -
- -
- ('peaches' peaches)
- -
- ('pears' pears)
- -))
- startUp: #apples"!

Item was removed:
- ----- Method: SelectionMenu class>>labels:lines:selections: (in category 'instance creation') -----
- labels: labels lines: linesArray selections: selectionsArray
- "Answer an instance of me whose items are in labels, with lines drawn  
- after each item indexed by linesArray. Labels can be either a string  
- with embedded CRs, or a collection of strings. Record the given array of
- selections corresponding to the items in labels."
-
- | labelString |
- (labels isString)
- ifTrue: [labelString := labels]
- ifFalse: [labelString := String streamContents:
- [:s |
- labels do: [:l | s nextPutAll: l; cr].
- s skip: -1]].
- ^ (self labels: labelString lines: linesArray) selections: selectionsArray
- !

Item was removed:
- ----- Method: SelectionMenu>>selections (in category 'accessing') -----
- selections
- ^ selections!

Item was removed:
- ----- Method: EmphasizedMenu class>>selectionAndEmphasisPairs: (in category 'instance creation') -----
- selectionAndEmphasisPairs: interleavedList
- "An alternative form of call.  "
- | selList  emphList |
- selList := OrderedCollection new.
- emphList := OrderedCollection new.
- interleavedList pairsDo:
- [:aSel :anEmph |
- selList add: aSel.
- emphList add: anEmph].
- ^ self selections:selList emphases: emphList!

Item was removed:
- ----- Method: CustomMenu>>startUpWithCaption: (in category 'invocation') -----
- startUpWithCaption: caption
- "Build and invoke this menu with no initial selection. Answer the selection associated with the menu item chosen by the user or nil if none is chosen; use the provided caption"
-
- ^ self startUp: nil withCaption: caption!

Item was removed:
- ----- Method: SelectionMenu>>invokeOn: (in category 'basic control sequence') -----
- invokeOn: targetObject
- "Pop up this menu and return the result of sending to the target object
- the selector corresponding to the menu item selected by the user. Return
- nil if no item is selected."
-
- | sel |
- sel := self startUp.
- sel = nil ifFalse: [^ targetObject perform: sel].
- ^ nil
-
- "Example:
- (SelectionMenu labels: 'sin
- cos
- neg' lines: #() selections: #(sin cos negated)) invokeOn: 0.7"!

Item was removed:
- ----- Method: CustomMenu>>preSelect: (in category 'private') -----
- preSelect: action
- "Pre-select and highlight the menu item associated with the given action."
-
- | i |
- i := selections indexOf: action ifAbsent: [^ self].
- marker ifNil: [self computeForm].
- marker := marker
- align: marker topLeft
- with: (marker left)@(frame inside top + (marker height * (i - 1))).
- selection := i.!

Item was removed:
- ----- Method: CustomMenu>>startUp (in category 'invocation') -----
- startUp
- "Build and invoke this menu with no initial selection. Answer the selection associated with the menu item chosen by the user or nil if none is chosen."
-
- ^ self startUp: nil!

Item was removed:
- ----- Method: CustomMenu>>startUp:withCaption: (in category 'invocation') -----
- startUp: initialSelection withCaption: caption
- "Build and invoke this menu with the given initial selection and caption. Answer the selection associated with the menu item chosen by the user or nil if none is chosen."
-
- self build.
- (initialSelection notNil) ifTrue: [self preSelect: initialSelection].
- ^ super startUpWithCaption: caption!

Item was removed:
- ----- Method: SelectionMenu class>>selections: (in category 'instance creation') -----
- selections: selectionsArray
- "Answer an instance of me whose labels and selections are identical."
-
- ^ self selections: selectionsArray lines: nil!

Item was removed:
- ----- Method: CustomMenu>>add:target:selector:argumentList: (in category 'compatibility') -----
- add: aString target: target selector: aSymbol argumentList: argList
- "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument."
-
- self add: aString action: aSymbol.
- targets addLast: target.
- arguments addLast: argList asArray
- !

Item was removed:
- ----- Method: EmphasizedMenu class>>example2 (in category 'examples') -----
- example2
- "EmphasizedMenu example2"
-
- | aMenu |
- aMenu := EmphasizedMenu selections: #('One' 'Two' 'Three' 'Four').
- aMenu onlyBoldItem: 3.
- ^ aMenu startUpWithCaption: 'Only the Bold'!