--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PopUpMenu.st Fri Jul 16 11:44:44 1993 +0200
@@ -0,0 +1,408 @@
+"
+ COPYRIGHT (c) 1989-93 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+PopUpView subclass:#PopUpMenu
+ instanceVariableNames:'menuView lastSelection memorize hideOnLeave
+ actionLabels actionLines actionValues'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Menus'
+!
+
+PopUpMenu comment:'
+
+COPYRIGHT (c) 1989-93 by Claus Gittinger
+ All Rights Reserved
+
+%W% %E%
+
+written summer 89 by claus;
+ST-80 compatibility added Dec 92;
+'!
+
+!PopUpMenu class methodsFor:'instance creation'!
+
+labels:labels selectors:selectors receiver:anObject for:aView
+ |newMenu|
+
+ aView isNil ifTrue:[
+ newMenu := self on:Display
+ ] ifFalse:[
+ newMenu := self on:(aView device)
+ ].
+ ^ newMenu menu:(MenuView
+ labels:labels
+ selectors:selectors
+ receiver:anObject
+ in:newMenu)
+!
+
+labels:labels selectors:selectors receiver:anObject
+ ^ self labels:labels selectors:selectors receiver:anObject for:nil
+!
+
+labels:labels selectors:selectors args:args receiver:anObject for:aView
+ |newMenu|
+
+ aView isNil ifTrue:[
+ newMenu := self on:Display
+ ] ifFalse:[
+ newMenu := self on:(aView device)
+ ].
+ ^ newMenu menu:(MenuView
+ labels:labels
+ selectors:selectors
+ args:args
+ receiver:anObject
+ in:newMenu)
+!
+
+labels:labels selectors:selectors args:args receiver:anObject
+ ^ self labels:labels
+ selectors:selectors
+ args:args
+ receiver:anObject
+ for:nil
+! !
+
+!PopUpMenu class methodsFor:'ST-80 instance creation'!
+
+labels:labels
+ ^ self labels:labels lines:nil values:nil
+!
+
+labels:labels values:values
+ ^ self labels:labels lines:nil values:values
+!
+
+labels:labels lines:lines
+ ^ self labels:labels lines:lines values:nil
+!
+
+labels:labels lines:lines values:values
+ ^ (self new) labels:labels lines:lines values:values
+!
+
+labelList:labels values:values
+ ^ self labels:labels lines:nil values:values
+!
+
+labelList:labels lines:lines values:values
+ ^ (self new) labels:labels lines:lines values:values
+! !
+
+!PopUpMenu methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ memorize := true.
+ hideOnLeave := false
+!
+
+initEvents
+ super initEvents.
+ self enableEnterLeaveEvents.
+ self enableButtonMotionEvents.
+ self enableMotionEvents.
+ self enableButtonEvents
+! !
+
+!PopUpMenu methodsFor:'realization'!
+
+fixSize
+ "adjust my size to the size of the actual menu"
+
+ |extra newWidth newHeight|
+
+ extra := margin * 2.
+ newWidth := menuView width + extra.
+ newHeight := menuView height + extra.
+ ((newWidth ~~ width) or:[newHeight ~~ height]) ifTrue:[
+ self extent:(menuView width + extra) @ (menuView height + extra)
+ ].
+ super fixSize
+!
+
+realize
+ menuView deselectWithoutRedraw.
+ super realize.
+
+ menuView disableButtonMotionEvents.
+ menuView disableMotionEvents.
+ menuView disableButtonEvents
+! !
+
+!PopUpMenu methodsFor:'private accessing'!
+
+menu:aMenu
+ "set the actual menu"
+
+ menuView := aMenu.
+ menuView origin:(margin @ margin).
+ menuView borderWidth:0
+!
+
+menuView
+ "return the actual menu"
+
+ ^ menuView
+! !
+
+!PopUpMenu methodsFor:'accessing'!
+
+viewBackground:aColor
+ "this is a kludge and will vanish ..."
+
+ super viewBackground:aColor.
+ menuView viewBackground:aColor
+!
+
+hideOnLeave:aBoolean
+ "set/clear the hideOnLeave attribute, which controls
+ if the menu should be hidden when the pointer leaves
+ the view (used with multiple-menus)"
+
+ hideOnLeave := aBoolean
+!
+
+enable:anEntry
+ "enable a menu entry"
+
+ menuView enable:anEntry
+!
+
+disable:anEntry
+ "disable a menu entry"
+
+ menuView disable:anEntry
+!
+
+receiver:anObject
+ menuView receiver:anObject
+!
+
+addLabel:aLabel selector:aSelector
+ "add a new menu entry to the end"
+
+ menuView addLabel:aLabel selector:aSelector
+!
+
+addLabel:aLabel selector:aSelector arg:anArg
+ "add a new menu entry to the end"
+
+ menuView addLabel:aLabel selector:aSelector arg:anArg
+!
+
+labelAt:index put:aString
+ "change a menu entry"
+
+ menuView labelAt:index put:aString
+!
+
+selectorAt:index put:aSymbol
+ "change a selector entry"
+
+ menuView selectorAt:index put:aSymbol
+!
+
+subMenuAt:indexOrName put:aMenu
+ "define a submenu to be shown for entry indexOrName"
+
+ aMenu hideOnLeave:true.
+ menuView subMenuAt:indexOrName put:aMenu
+
+ "|v m|
+ v := View new.
+ m := PopUpMenu labels:#('1' '2' '3')
+ selectors:#(one two nil)
+ receiver:v
+ for:nil.
+ m subMenuAt:3 put:(PopUpMenu
+ labels:#('a' 'b' 'c')
+ selectors:#(a b c)
+ receiver:v
+ for:nil).
+ v middleButtonMenu:m.
+ v realize"
+!
+
+checkToggleAt:index
+ "return a checkToggles state"
+
+ ^ menuView checkToggleAt:index
+!
+
+checkToggleAt:index put:aBoolean
+ "set/clear a checkToggle"
+
+ ^ menuView checkToggleAt:index put:aBoolean
+! !
+
+!PopUpMenu methodsFor:'ST-80 accessing'!
+
+numberOfItems
+ ^ actionLabels asText size
+!
+
+labels
+ ^ actionLabels asText
+!
+
+values
+ ^ actionValues
+!
+
+lines
+ ^ actionLines
+!
+
+labels:labelString lines:lineArray values:valueArray
+ "define the menu the ST-80 way (with labels and lines
+ defined separately)"
+
+ |labelArray argArray convertedLabels
+ offs dstOffs linePos|
+
+ actionLabels := labelString.
+ actionLines := lineArray.
+ actionValues := valueArray.
+
+ labelArray := labelString asText.
+
+ convertedLabels := Array new:(labelArray size + lineArray size).
+ argArray := Array new:(labelArray size + lineArray size).
+
+ offs := 1.
+ dstOffs := 1.
+ 1 to:lineArray size do:[:lineIndex |
+ linePos := lineArray at:lineIndex.
+ [offs <= linePos] whileTrue:[
+ convertedLabels at:dstOffs put:(labelArray at:offs).
+ argArray at:dstOffs put:offs.
+ offs := offs + 1.
+ dstOffs := dstOffs + 1
+ ].
+ convertedLabels at:dstOffs put:'-'.
+ argArray at:dstOffs put:nil.
+ dstOffs := dstOffs + 1
+ ].
+ [offs <= labelArray size] whileTrue:[
+ convertedLabels at:dstOffs put:(labelArray at:offs).
+ argArray at:dstOffs put:offs.
+ offs := offs + 1.
+ dstOffs := dstOffs + 1
+ ].
+ self menu:(MenuView
+ labels:convertedLabels
+ selector:nil
+ args:argArray
+ receiver:nil
+ in:self)
+
+! !
+
+!PopUpMenu methodsFor:'activation'!
+
+showAt:aPoint
+ "realize the menu at aPoint - return control"
+
+ self fixSize.
+ self origin:aPoint.
+ ((top + height) > (device height)) ifTrue:[
+ self top:(device height - height)
+ ].
+ ((left + width) > (device width)) ifTrue:[
+ self left:(device width - width)
+ ].
+ self realize
+!
+
+showAtPointer
+ "realize the menu at the current pointer position - return control"
+
+ self showAt:(device pointerPosition)
+!
+
+show
+ "realize the menu at its last position - return control"
+
+ self fixSize.
+ self realize
+!
+
+hide
+ "hide the menu"
+
+ ^ self unrealize
+! !
+
+!PopUpMenu methodsFor:'ST-80 activation'!
+
+startUp
+ "start the menu modal - return the selected selector,
+ or - if no selectors where specified - the index.
+ If nothing was selected, return 0.
+ Modal - i.e. stay in the menu until finished"
+
+ |actionIndex value|
+
+ menuView action:[:selected |
+ menuView args isNil ifTrue:[
+ menuView selectors isNil ifTrue:[
+ ^ 0
+ ].
+ ^ menuView receiver perform:(menuView selectors at:selected)
+ ].
+ actionIndex := menuView args at:selected.
+ actionIndex isNil ifTrue:[^ 0].
+ actionValues isNil ifTrue:[^ actionIndex].
+ value := actionValues at:actionIndex.
+ (value isKindOf:PopUpMenu) ifTrue:[
+ ^ value startUp
+ ].
+ ^ value
+ ].
+ self showAtPointer.
+ self modalLoop.
+ ^ 0
+! !
+
+!PopUpMenu methodsFor:'events'!
+
+buttonMotion:button x:x y:y
+ (x >= 0) ifTrue:[
+ (x < width) ifTrue:[
+ (y >= 0) ifTrue:[
+ (y < height) ifTrue:[
+ menuView buttonMotion:button x:x y:y.
+ ^ self
+ ]
+ ]
+ ]
+ ].
+ menuView pointerLeave:button.
+ hideOnLeave ifTrue:[
+ self hide
+ ]
+!
+
+pointerLeave:state
+ menuView pointerLeave:state.
+ hideOnLeave ifTrue:[
+ self hide
+ ]
+!
+
+buttonRelease:button x:x y:y
+ self hide.
+ menuView buttonRelease:button x:x y:y
+! !