The Trunk: Tools-dtl.170.mcz

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

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

Name: Tools-dtl.170
Author: dtl
Time: 6 February 2010, 10:29:09.745 pm
UUID: dc0cf3b5-953f-45f2-b753-d4b8ebfd91d0
Ancestors: Tools-ul.169

Move StandardFileMenu from Morphic-FileList to Tools-Menus. StandardFileMenu is not Morphic specific.

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

With these changes, PopUpMenu and all its subclasses are in package Tools-Menus. The MVC/Morphic dependencies are handled in PopUpMenu>>startUpLeftFlush and PopUpMenu>>startUpWithCaption:icon:at:allowKeyboard:

=============== Diff against Tools-ul.169 ===============

Item was added:
+ ----- Method: StandardFileMenu>>makeFileMenuFor: (in category 'menu building') -----
+ makeFileMenuFor: aDirectory
+ "Initialize an instance of me to operate on aDirectory"
+
+ | theMenu |
+ pattern ifNil: [pattern := {'*'}].
+ Cursor wait showWhile:
+ [self
+ labels: (self menuLabelsString: aDirectory)
+ font: (MenuStyle fontAt: 1)
+ lines: (self menuLinesArray: aDirectory).
+ theMenu := self selections: (self menuSelectionsArray: aDirectory)].
+ ^theMenu!

Item was added:
+ ----- Method: StandardFileMenu class>>oldFileStream (in category 'standard file operations') -----
+ oldFileStream
+
+ ^self oldFileStreamFrom: (FileDirectory default)
+ !

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu class>>newFileMenu:withPatternList: (in category 'instance creation') -----
+ newFileMenu: aDirectory withPatternList: aPatternList
+ Smalltalk isMorphic ifFalse: [^ PluggableFileList newFileMenu: aDirectory].
+ ^ super new newFileFrom: aDirectory withPatternList: aPatternList!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu>>menuSelectionsArray: (in category 'menu building') -----
+ menuSelectionsArray: aDirectory
+ "Answer a menu selections object corresponding to aDirectory.  The object is an array corresponding to each item, each element itself constituting a two-element array, the first element of which contains a selector to operate on and the second element of which contains the parameters for that selector."
+
+ |dirSize|
+ dirSize := aDirectory pathParts size.
+ ^Array streamContents: [:s |
+ canTypeFileName ifTrue:
+ [s nextPut: (StandardFileMenuResult
+ directory: aDirectory
+ name: nil)].
+ s nextPut: (StandardFileMenuResult
+ directory: (FileDirectory root)
+ name: '').
+ aDirectory pathParts doWithIndex:
+ [:d :i | s nextPut: (StandardFileMenuResult
+ directory: (self
+ advance: dirSize - i
+ containingDirectoriesFrom: aDirectory)
+ name: '')].
+ aDirectory directoryNames do:
+ [:dn |  s nextPut: (StandardFileMenuResult
+ directory: (FileDirectory on: (aDirectory fullNameFor: dn))
+ name: '')].
+ aDirectory fileNames do:
+ [:fn | pattern do: [:pat | (pat match: fn) ifTrue: [
+ s nextPut: (StandardFileMenuResult
+ directory: aDirectory
+ name: fn)]]]]!

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

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ PopUpMenu subclass: #SelectionMenu
+ instanceVariableNames: 'selections'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Tools-Menus'!

Item was added:
+ ----- Method: StandardFileMenu>>computeLabelParagraph (in category 'private') -----
+ computeLabelParagraph
+ "Answer a Paragraph containing this menu's labels, one per line and centered."
+
+ ^ Paragraph withText: labelString asText style: (MenuStyle leftFlush)!

Item was added:
+ ----- Method: StandardFileMenu>>menuLinesArray: (in category 'menu building') -----
+ menuLinesArray: aDirectory
+ "Answer a menu lines object corresponding to aDirectory"
+
+ | typeCount nameCnt dirDepth|
+ typeCount := canTypeFileName
+ ifTrue: [1]
+ ifFalse: [0].
+ nameCnt := aDirectory directoryNames size.
+ dirDepth := aDirectory pathParts size.
+ ^Array streamContents: [:s |
+ canTypeFileName ifTrue: [s nextPut: 1].
+ s nextPut: dirDepth + typeCount + 1.
+ s nextPut: dirDepth + nameCnt + typeCount + 1]!

Item was added:
+ ----- 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'!

Item was added:
+ ----- Method: StandardFileMenu class>>oldFile (in category 'standard file operations') -----
+ oldFile
+
+ ^self oldFileFrom: (FileDirectory default)!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu>>newFileFrom: (in category 'private') -----
+ newFileFrom: aDirectory
+
+ canTypeFileName := true.
+ ^self makeFileMenuFor: aDirectory!

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

Item was added:
+ ----- Method: StandardFileMenu>>pattern: (in category 'private') -----
+ pattern: aPattern
+ " * for all files, or '*.cs' for changeSets, etc.  Just like fileLists"
+
+ pattern := {aPattern}!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu class>>newFileFrom: (in category 'standard file operations') -----
+ newFileFrom: aDirectory
+
+ ^(self newFileMenu: aDirectory)
+ startUpWithCaption: 'Select a File:' translated!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: CustomMenu>>balloonTextForLastItem: (in category 'construction') -----
+ balloonTextForLastItem: aString
+ "Vacuous backstop provided for compatibility with MorphicMenu"!

Item was added:
+ ----- Method: StandardFileMenu class>>newFileMenu:withPattern: (in category 'instance creation') -----
+ newFileMenu: aDirectory withPattern: aPattern
+ Smalltalk isMorphic ifFalse: [^ PluggableFileList newFileMenu: aDirectory].
+ ^ super new newFileFrom: aDirectory withPattern: aPattern!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: CustomMenu>>title: (in category 'initialize-release') -----
+ title: aTitle
+ title := aTitle!

Item was added:
+ ----- Method: StandardFileMenu>>pathPartsString: (in category 'menu building') -----
+ pathPartsString: aDirectory
+ "Answer a string concatenating the path parts strings in aDirectory, each string followed by a cr."
+
+ ^String streamContents:
+ [:s |
+ s nextPutAll: '[]'; cr.
+ aDirectory pathParts asArray doWithIndex:
+ [:part :i |
+ s next: i put: $ .
+ s nextPutAll: part withBlanksTrimmed; cr]]!

Item was added:
+ ----- 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 added:
+ ----- Method: SelectionMenu>>selections: (in category 'accessing') -----
+ selections: selectionArray
+ selections := selectionArray!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu class>>newFileMenu: (in category 'instance creation') -----
+ newFileMenu: aDirectory
+ Smalltalk isMorphic ifFalse: [^ PluggableFileList newFileMenu: aDirectory].
+ ^ super new newFileFrom: aDirectory!

Item was added:
+ ----- Method: StandardFileMenu>>patternList: (in category 'private') -----
+ patternList: aPatternList
+
+ pattern := aPatternList!

Item was added:
+ ----- Method: StandardFileMenu class>>oldFileMenu:withPattern: (in category 'instance creation') -----
+ oldFileMenu: aDirectory withPattern: aPattern
+
+ Smalltalk isMorphic ifFalse: [^PluggableFileList oldFileMenu: aDirectory].
+ ^super new oldFileFrom: aDirectory withPattern: aPattern!

Item was added:
+ ----- Method: StandardFileMenu>>advance:containingDirectoriesFrom: (in category 'private') -----
+ advance: anInteger containingDirectoriesFrom: aDirectory
+
+ | theDirectory |
+ theDirectory := aDirectory.
+ 1 to: anInteger do: [:i | theDirectory := theDirectory containingDirectory].
+ ^theDirectory!

Item was added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu>>getTypedFileName: (in category 'basic control sequences') -----
+ getTypedFileName: aResult
+
+ | name |
+ name := UIManager default
+ request: 'Enter a new file name'
+ initialAnswer: ''.
+ name = '' ifTrue: [^self startUpWithCaption: 'Select a File:' translated].
+ name := aResult directory fullNameFor: name.
+ ^ StandardFileMenuResult
+ directory: (FileDirectory forFileName: name)
+ name: (FileDirectory localNameFor: name)
+ !

Item was added:
+ ----- Method: StandardFileMenu>>startUpWithCaption:at: (in category 'basic control sequences') -----
+ startUpWithCaption: aString at: location
+
+ |result|
+ result := super startUpWithCaption: aString at: location.
+ result ifNil: [^nil].
+ result isDirectory ifTrue:
+ [self makeFileMenuFor: result directory.
+ self computeForm.
+ ^self startUpWithCaption: aString at: location].
+ result isCommand ifTrue:
+ [result := self getTypedFileName: result.
+ result ifNil: [^nil]].
+ canTypeFileName ifTrue: [^self confirmExistingFiles: result].
+ ^result
+ !

Item was added:
+ ----- Method: StandardFileMenu>>fileNamesString: (in category 'menu building') -----
+ fileNamesString: aDirectory
+ "Answer a string concatenating the file name strings in aDirectory, each string followed by a cr."
+
+ ^String streamContents:
+ [:s |
+ aDirectory fileNames do:
+ [:fn |
+ pattern do:[:each | (each match: fn) ifTrue: [
+ s nextPutAll: fn withBlanksTrimmed; cr]]]]
+ !

Item was added:
+ ----- Method: StandardFileMenu class>>newFileStream (in category 'standard file operations') -----
+ newFileStream
+
+ ^self newFileStreamFrom: (FileDirectory default)!

Item was added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu>>oldFileFrom: (in category 'private') -----
+ oldFileFrom: aDirectory
+
+ canTypeFileName := false.
+ ^self makeFileMenuFor: aDirectory!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: SelectionMenu class>>labelList:selections: (in category 'instance creation') -----
+ labelList: labelList selections: selections
+ ^ self
+ labelList: labelList
+ lines: #()
+ selections: selections!

Item was added:
+ SelectionMenu subclass: #EmphasizedMenu
+ instanceVariableNames: 'emphases'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Tools-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 added:
+ ----- Method: StandardFileMenu class>>oldFileMenu:withPatternList: (in category 'instance creation') -----
+ oldFileMenu: aDirectory withPatternList: aPatternList
+
+ Smalltalk isMorphic ifFalse: [^PluggableFileList oldFileMenu: aDirectory].
+ ^super new oldFileFrom: aDirectory withPatternList: aPatternList!

Item was added:
+ ----- Method: StandardFileMenu class>>oldFileFrom: (in category 'standard file operations') -----
+ oldFileFrom: aDirectory
+
+ ^(self oldFileMenu: aDirectory)
+ startUpWithCaption: 'Select a File:' translated!

Item was added:
+ ----- Method: StandardFileMenu class>>newFileStreamFrom: (in category 'standard file operations') -----
+ newFileStreamFrom: aDirectory
+
+ | sfmResult fileStream |
+ sfmResult := self newFileFrom: aDirectory.
+ sfmResult ifNil: [^nil].
+ fileStream := sfmResult directory newFileNamed: sfmResult name.
+ [fileStream isNil] whileTrue:
+ [sfmResult := self newFileFrom: aDirectory.
+ sfmResult ifNil: [^nil].
+ fileStream := sfmResult directory newFileNamed: sfmResult name].
+ ^fileStream
+ !

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: CustomMenu>>addStayUpItem (in category 'construction') -----
+ addStayUpItem
+ "For compatibility with MenuMorph.  Here it is a no-op"!

Item was added:
+ ----- Method: StandardFileMenu>>newFileFrom:withPattern: (in category 'private') -----
+ newFileFrom: aDirectory withPattern: aPattern
+
+ canTypeFileName := true.
+ pattern := {aPattern}.
+ ^self makeFileMenuFor: aDirectory!

Item was added:
+ ----- Method: StandardFileMenu>>directoryNamesString: (in category 'menu building') -----
+ directoryNamesString: aDirectory
+ "Answer a string concatenating the directory name strings in aDirectory, each string followed by a '[...]' indicator, and followed by a cr."
+
+ ^ String streamContents:
+ [:s | aDirectory directoryNames do:
+ [:dn | s nextPutAll: dn withBlanksTrimmed , ' [...]'; cr]]
+
+ !

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: EmphasizedMenu>>emphases: (in category 'emphasis') -----
+ emphases: emphasisArray
+ emphases := emphasisArray!

Item was added:
+ ----- 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 added:
+ ----- Method: EmphasizedMenu>>startUpWithCaption: (in category 'display') -----
+ startUpWithCaption: captionOrNil
+ self setEmphasis.
+ ^ super startUpWithCaption: captionOrNil!

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

Item was added:
+ ----- 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 added:
+ SelectionMenu subclass: #StandardFileMenu
+ instanceVariableNames: 'canTypeFileName pattern'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Tools-Menus'!
+
+ !StandardFileMenu commentStamp: 'mp 8/15/2005 18:44' prior: 0!
+ I represent a SelectionMenu which operates like a modal dialog for selecting files, somewhat similar to the StandardFile dialogs in MacOS and Java Swing.
+
+ Try for example, the following:
+
+ StandardFileMenu oldFile inspect
+
+ StandardFileMenu oldFileStream inspect
+
+ StandardFileMenu newFile inspect
+
+ StandardFileMenu newFileStream inspect
+
+ (StandardFileMenu oldFileMenu: FileDirectory default withPattern: '*') startUpWithCaption: 'Select a file:'
+
+ (StandardFileMenu oldFileMenu: (FileDirectory default) withPatternList: {'*.txt'. '*.changes'}) startUpWithCaption: 'Select a file:'
+ !

Item was added:
+ ----- Method: StandardFileMenu class>>oldFileMenu: (in category 'instance creation') -----
+ oldFileMenu: aDirectory
+ Smalltalk isMorphic ifFalse: [^ PluggableFileList oldFileMenu: aDirectory].
+ ^ super new oldFileFrom: aDirectory!

Item was added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu>>newFileFrom:withPatternList: (in category 'private') -----
+ newFileFrom: aDirectory withPatternList: aPatternList
+
+ canTypeFileName := true.
+ pattern := aPatternList.
+ ^self makeFileMenuFor: aDirectory!

Item was added:
+ ----- Method: StandardFileMenu>>oldFileFrom:withPattern: (in category 'private') -----
+ oldFileFrom: aDirectory withPattern: aPattern
+
+ canTypeFileName := false.
+ pattern := {aPattern}.
+ ^self makeFileMenuFor: aDirectory!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu>>oldFileFrom:withPatternList: (in category 'private') -----
+ oldFileFrom: aDirectory withPatternList: aPatternList
+
+ canTypeFileName := false.
+ pattern := aPatternList.
+ ^self makeFileMenuFor: aDirectory!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu class>>oldFileFrom:withPattern: (in category 'standard file operations') -----
+ oldFileFrom: aDirectory withPattern: aPattern
+ "
+ Select an existing file from a selection conforming to aPattern.
+ "
+ ^(self oldFileMenu: aDirectory withPattern: aPattern)
+ startUpWithCaption: 'Select a File:' translated!

Item was added:
+ SelectionMenu subclass: #CustomMenu
+ instanceVariableNames: 'labels dividers lastDivider title targets arguments'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Tools-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 added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu>>menuLabelsString: (in category 'menu building') -----
+ menuLabelsString: aDirectory
+ "Answer a menu labels object corresponding to aDirectory"
+
+ ^ String streamContents:
+ [:s |
+ canTypeFileName ifTrue:
+ [s nextPutAll: 'Enter File Name...'; cr].
+ s nextPutAll: (self pathPartsString: aDirectory).
+ s nextPutAll: (self directoryNamesString: aDirectory).
+ s nextPutAll: (self fileNamesString: aDirectory).
+ s skip: -1]!

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu class>>oldFileStreamFrom: (in category 'standard file operations') -----
+ oldFileStreamFrom: aDirectory
+
+ | sfmResult fileStream |
+ sfmResult := self oldFileFrom: aDirectory.
+ sfmResult ifNil: [^nil].
+ fileStream := sfmResult directory oldFileNamed: sfmResult name.
+ [fileStream isNil] whileTrue:
+ [sfmResult := self oldFileFrom: aDirectory.
+ sfmResult ifNil: [^nil].
+ fileStream := sfmResult directory oldFileNamed: sfmResult name].
+ ^fileStream
+ !

Item was added:
+ ----- 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 added:
+ ----- Method: StandardFileMenu class>>newFile (in category 'standard file operations') -----
+ newFile
+
+ ^self newFileFrom: (FileDirectory default)!

Item was added:
+ ----- Method: StandardFileMenu>>confirmExistingFiles: (in category 'basic control sequences') -----
+ confirmExistingFiles: aResult
+
+ |choice|
+ (aResult directory fileExists: aResult name) ifFalse: [^aResult].
+
+ choice := (UIManager default chooseFrom: #('overwrite that file' 'choose another name'
+  'cancel')
+ title: aResult name, '
+ already exists.').
+
+ choice = 1 ifTrue: [
+ aResult directory
+ deleteFileNamed: aResult name
+ ifAbsent:
+ [^self startUpWithCaption:
+ 'Can''t delete ', aResult name, '
+ Select another file'].
+ ^aResult].
+ choice = 2 ifTrue: [^self startUpWithCaption: 'Select Another File'].
+ ^nil
+  !