MenuPanel.st
changeset 1726 a4733a8b51e1
parent 1723 f633725a0ace
child 1727 a6365337be59
equal deleted inserted replaced
1725:897453804fa8 1726:a4733a8b51e1
    19 		itemSpace fitFirstPanel rightArrow rightArrowShadow
    19 		itemSpace fitFirstPanel rightArrow rightArrowShadow
    20 		selectionFrameBrightColor selectionFrameDarkColor
    20 		selectionFrameBrightColor selectionFrameDarkColor
    21 		buttonLightColor buttonShadowColor buttonHalfLightColor
    21 		buttonLightColor buttonShadowColor buttonHalfLightColor
    22 		buttonHalfShadowColor enteredItem buttonEnteredBgColor
    22 		buttonHalfShadowColor enteredItem buttonEnteredBgColor
    23 		prevFocusView previousPointerGrab previousKeyboardGrab
    23 		prevFocusView previousPointerGrab previousKeyboardGrab
    24 		relativeGrabOrigin hasImplicitGrap'
    24 		relativeGrabOrigin hasImplicitGrap iconIndicationOff
    25 	classVariableNames:'InitialSelectionQuerySignal DefaultAdornment
    25 		iconIndicationOn iconRadioGroupOff iconRadioGroupOn'
       
    26 	classVariableNames:'InitialSelectionQuerySignal DefaultAdornment ShortcutKeyOffset
    26 		DefaultGroupDividerSize DefaultHilightLevel DefaultLevel
    27 		DefaultGroupDividerSize DefaultHilightLevel DefaultLevel
    27 		DefaultItemSpace DefaultButtonItemSpace DefaultForegroundColor
    28 		DefaultItemSpace DefaultButtonItemSpace DefaultForegroundColor
    28 		DefaultBackgroundColor DefaultHilightForegroundColor
    29 		DefaultBackgroundColor DefaultHilightForegroundColor
    29 		DefaultHilightBackgroundColor DefaultDisabledForegroundColor
    30 		DefaultHilightBackgroundColor DefaultDisabledForegroundColor
    30 		DefaultEnteredLevel DefaultSelectionFollowsMouse
    31 		DefaultEnteredLevel DefaultSelectionFollowsMouse
    37 	poolDictionaries:''
    38 	poolDictionaries:''
    38 	category:'Views-Menus'
    39 	category:'Views-Menus'
    39 !
    40 !
    40 
    41 
    41 Object subclass:#Item
    42 Object subclass:#Item
    42 	instanceVariableNames:'layout menuPanel subMenu adornment rawLabel disabledRawLabel
    43 	instanceVariableNames:'layout menuPanel subMenu rawLabel rawLabelExtent disabledRawLabel
    43 		enableChannel nameKey accessCharacterPosition value label
    44 		enableChannel nameKey value label activeHelpKey activeHelpText
    44 		shortcutKey rawImage activeHelpKey activeHelpText submenuChannel
    45 		submenuChannel startGroup isButton isVisible hideMenuOnActivated
    45 		startGroup isButton isVisible hideMenuOnActivated'
    46 		indication accessCharacterPosition shortcutKey argument choice
       
    47 		choiceValue showBusyCursorWhilePerforming accessCharacter'
    46 	classVariableNames:'HorizontalInset VerticalInset HorizontalButtonInset
    48 	classVariableNames:'HorizontalInset VerticalInset HorizontalButtonInset
    47 		VerticalButtonInset LabelRightOffset ShortcutKeyOffset
    49 		VerticalButtonInset LabelRightOffset'
    48 		IndicatorOn IndicatorOff'
       
    49 	poolDictionaries:''
    50 	poolDictionaries:''
    50 	privateIn:MenuPanel
    51 	privateIn:MenuPanel
    51 !
       
    52 
       
    53 Object subclass:#Adornment
       
    54 	instanceVariableNames:'indication accessCharacterPosition shortcutKey argument choice
       
    55 		choiceValue showBusyCursorWhilePerforming'
       
    56 	classVariableNames:''
       
    57 	poolDictionaries:''
       
    58 	privateIn:MenuPanel::Item
       
    59 !
    52 !
    60 
    53 
    61 !MenuPanel class methodsFor:'documentation'!
    54 !MenuPanel class methodsFor:'documentation'!
    62 
    55 
    63 copyright
    56 copyright
   315     Images := nil.
   308     Images := nil.
   316     LigthenedImages := nil.
   309     LigthenedImages := nil.
   317 
   310 
   318 ! !
   311 ! !
   319 
   312 
       
   313 !MenuPanel class methodsFor:'default icons'!
       
   314 
       
   315 iconIndicationOff
       
   316     "This resource specification was automatically generated
       
   317      by the ImageEditor of ST/X."
       
   318 
       
   319     "Do not manually edit this!! If it is corrupted,
       
   320      the ImageEditor may not be able to read the specification."
       
   321 
       
   322     "
       
   323      self iconIndicationOff inspect
       
   324      ImageEditor openOnClass:self andSelector:#iconIndicationOff
       
   325     "
       
   326 
       
   327     <resource: #image>
       
   328 
       
   329     ^Icon
       
   330         constantNamed:#'MenuPanel iconIndicationOff'
       
   331         ifAbsentPut:[(Depth2Image new) width: 14; height: 14; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'UUUUPG???8A0@@B@\@@@ G@@@HA0@@B@\@@@ G@@@HA0@@B@\@@@ G@@@HA0@@B@Z*** @@@@@@b') ; colorMapFromArray:#[255 255 255 127 127 127 170 170 170 0 0 0]; mask:((Depth1Image new) width: 14; height: 14; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'??3??O?<??3??O?<??3??O?<??3??O?<??3??@@a') ; yourself); yourself]!
       
   332 
       
   333 iconIndicationOn
       
   334     "This resource specification was automatically generated
       
   335      by the ImageEditor of ST/X."
       
   336 
       
   337     "Do not manually edit this!! If it is corrupted,
       
   338      the ImageEditor may not be able to read the specification."
       
   339 
       
   340     "
       
   341      self iconIndicationOn inspect
       
   342      ImageEditor openOnClass:self andSelector:#iconIndicationOn
       
   343     "
       
   344 
       
   345     <resource: #image>
       
   346 
       
   347     ^Icon
       
   348         constantNamed:#'MenuPanel iconIndicationOn'
       
   349         ifAbsentPut:[(Depth2Image new) width: 14; height: 14; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'****$H@@@MBEUUWP!!UUU4HUUT]BEUTGP!!ETA4HPTA]BD@AWP!!PAU4HUAU]BEUUWP/???4EUUUU@b') ; colorMapFromArray:#[0 0 0 255 255 255 127 127 127 170 170 170]; mask:((Depth1Image new) width: 14; height: 14; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'??3??O?<??3??O?<??3??O?<??3??O?<??3??@@a') ; yourself); yourself]!
       
   350 
       
   351 iconRadioGroupOff
       
   352     "This resource specification was automatically generated
       
   353      by the ImageEditor of ST/X."
       
   354 
       
   355     "Do not manually edit this!! If it is corrupted,
       
   356      the ImageEditor may not be able to read the specification."
       
   357 
       
   358     "
       
   359      self iconRadioGroupOff inspect
       
   360      ImageEditor openOnClass:self andSelector:#iconRadioGroupOff
       
   361     "
       
   362 
       
   363     <resource: #image>
       
   364 
       
   365     ^Icon
       
   366         constantNamed:#'MenuPanel iconRadioGroupOff'
       
   367         ifAbsentPut:[(Depth2Image new) width: 15; height: 15; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@AUP@@E@AP@DO?Y@D_?>(AO??;AO???LS???3D???<1O???LS???3A_??3@Z??<0A+?00@C@C0@@O?@@') ; colorMapFromArray:#[0 0 0 85 85 85 170 170 170 255 255 255]; mask:((Depth1Image new) width: 15; height: 15; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'A<@_<C?8_?1??O?:??+?>/?:??)?=G?4O< HL@_@') ; yourself); yourself]!
       
   368 
       
   369 iconRadioGroupOn
       
   370     "This resource specification was automatically generated
       
   371      by the ImageEditor of ST/X."
       
   372 
       
   373     "Do not manually edit this!! If it is corrupted,
       
   374      the ImageEditor may not be able to read the specification."
       
   375 
       
   376     "
       
   377      self iconRadioGroupOn inspect
       
   378      ImageEditor openOnClass:self andSelector:#iconRadioGroupOn
       
   379     "
       
   380 
       
   381     <resource: #image>
       
   382 
       
   383     ^Icon
       
   384         constantNamed:#'MenuPanel iconRadioGroupOn'
       
   385         ifAbsentPut:[(Depth2Image new) width: 15; height: 15; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@AUP@@E@AP@DO?Y@D]@^(AL@@;AM@@GLS@@@3D0@@L1L@@CLSP@A3A\@@3@Z4A<0A+?00@C@C0@@O?@@') ; colorMapFromArray:#[0 0 0 85 85 85 170 170 170 255 255 255]; mask:((Depth1Image new) width: 15; height: 15; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'A<@_<C?8_?1??O?:??+?>/?:??)?=G?4O< HL@_@') ; yourself); yourself]! !
       
   386 
   320 !MenuPanel class methodsFor:'defaults'!
   387 !MenuPanel class methodsFor:'defaults'!
   321 
   388 
   322 updateStyleCache
   389 updateStyleCache
   323 
   390 
   324     <resource: #style (#'menu.foregroundColor' #'menu.backgroundColor'
   391     <resource: #style (#'menu.foregroundColor' #'menu.backgroundColor'
   437     ].
   504     ].
   438     ButtonEnteredLevel := styleSheet at:#'menu.buttonEnteredLevel' default:ButtonPassiveLevel.
   505     ButtonEnteredLevel := styleSheet at:#'menu.buttonEnteredLevel' default:ButtonPassiveLevel.
   439 
   506 
   440     DefaultSelectionFollowsMouse := styleSheet at:#'menu.selectionFollowsMouse' default:false.
   507     DefaultSelectionFollowsMouse := styleSheet at:#'menu.selectionFollowsMouse' default:false.
   441     DefaultEnteredLevel          := styleSheet at:#'menu.enteredLevel'          default:0.
   508     DefaultEnteredLevel          := styleSheet at:#'menu.enteredLevel'          default:0.
       
   509 
       
   510     ShortcutKeyOffset            := 5.
   442 
   511 
   443     Item updateStyleCache
   512     Item updateStyleCache
   444 
   513 
   445     "
   514     "
   446      self updateStyleCache
   515      self updateStyleCache
  1313         (hasMenu or:[shCtKey ~~ 0]) ifTrue:[
  1382         (hasMenu or:[shCtKey ~~ 0]) ifTrue:[
  1314             shortKeyInset := x + Item labelRightOffset.
  1383             shortKeyInset := x + Item labelRightOffset.
  1315             x := shortKeyInset + shCtKey + self subMenuIndicationWidth.
  1384             x := shortKeyInset + shCtKey + self subMenuIndicationWidth.
  1316 
  1385 
  1317             (shCtKey ~~ 0 and:[hasMenu]) ifTrue:[
  1386             (shCtKey ~~ 0 and:[hasMenu]) ifTrue:[
  1318                 x := x + (Item shortcutKeyOffset) 
  1387                 x := x + ShortcutKeyOffset 
  1319             ]
  1388             ]
  1320         ].
  1389         ].
  1321 "/ to have a small inset
  1390 "/ to have a small inset
  1322         y := y + 1.
  1391         y := y + 1.
  1323 "/        x := x + 1.
  1392 "/        x := x + 1.
  1334   ^ shortKeyInset
  1403   ^ shortKeyInset
  1335 !
  1404 !
  1336 
  1405 
  1337 subMenuIndicationWidth
  1406 subMenuIndicationWidth
  1338     ^ RightArrowForm width
  1407     ^ RightArrowForm width
       
  1408 ! !
       
  1409 
       
  1410 !MenuPanel methodsFor:'accessing-interactors'!
       
  1411 
       
  1412 iconIndicationOff
       
  1413     iconIndicationOff isNil ifTrue:[
       
  1414         superMenu notNil ifTrue:[
       
  1415             iconIndicationOff := superMenu iconIndicationOff
       
  1416         ] ifFalse:[
       
  1417             iconIndicationOff := self registerImageOnDevice:(self class iconIndicationOff)
       
  1418         ].
       
  1419     ].
       
  1420     ^ iconIndicationOff
       
  1421 !
       
  1422 
       
  1423 iconIndicationOn
       
  1424     iconIndicationOn isNil ifTrue:[
       
  1425         superMenu notNil ifTrue:[
       
  1426             iconIndicationOn := superMenu iconIndicationOn
       
  1427         ] ifFalse:[
       
  1428             iconIndicationOn := self registerImageOnDevice:(self class iconIndicationOn)
       
  1429         ].
       
  1430     ].
       
  1431     ^ iconIndicationOn
       
  1432 !
       
  1433 
       
  1434 iconRadioGroupOff
       
  1435     iconRadioGroupOff isNil ifTrue:[
       
  1436         superMenu notNil ifTrue:[
       
  1437             iconRadioGroupOff := superMenu iconRadioGroupOff
       
  1438         ] ifFalse:[
       
  1439             iconRadioGroupOff := self registerImageOnDevice:(self class iconRadioGroupOff)
       
  1440         ].
       
  1441     ].
       
  1442     ^ iconRadioGroupOff
       
  1443 !
       
  1444 
       
  1445 iconRadioGroupOn
       
  1446     iconRadioGroupOn isNil ifTrue:[
       
  1447         superMenu notNil ifTrue:[
       
  1448             iconRadioGroupOn := superMenu iconRadioGroupOn
       
  1449         ] ifFalse:[
       
  1450             iconRadioGroupOn := self registerImageOnDevice:(self class iconRadioGroupOn)
       
  1451         ].
       
  1452     ].
       
  1453     ^ iconRadioGroupOn
  1339 ! !
  1454 ! !
  1340 
  1455 
  1341 !MenuPanel methodsFor:'accessing-items'!
  1456 !MenuPanel methodsFor:'accessing-items'!
  1342 
  1457 
  1343 itemAt:stringOrNumber
  1458 itemAt:stringOrNumber
  3205     ].
  3320     ].
  3206     menu openMenusFromItems:loItems.
  3321     menu openMenusFromItems:loItems.
  3207     ^ true.
  3322     ^ true.
  3208 !
  3323 !
  3209 
  3324 
       
  3325 registerImageOnDevice:anImage
       
  3326     |image|
       
  3327 
       
  3328     (image := anImage) notNil ifTrue:[
       
  3329         image device ~~ device ifTrue:[
       
  3330             image := image copy.
       
  3331         ].
       
  3332         image := image on:device.
       
  3333         image := image clearMaskedPixels.
       
  3334     ].
       
  3335     ^ image
       
  3336 !
       
  3337 
  3210 selectItemsForShortcutKey:aKey maxDepth:maxDepth
  3338 selectItemsForShortcutKey:aKey maxDepth:maxDepth
  3211     "get sequence of items up to the item providing the key (inclusive). The
  3339     "get sequence of items up to the item providing the key (inclusive). The
  3212      last entry into the collection is the item providing the key, the first
  3340      last entry into the collection is the item providing the key, the first
  3213      entry is the item in the topMenu
  3341      entry is the item in the topMenu
  3214     "
  3342     "
  3219     self do:[:anItem|
  3347     self do:[:anItem|
  3220         anItem isEnabled ifTrue:[
  3348         anItem isEnabled ifTrue:[
  3221             anItem shortcutKey == aKey ifTrue:[
  3349             anItem shortcutKey == aKey ifTrue:[
  3222                 seq := OrderedCollection new.
  3350                 seq := OrderedCollection new.
  3223             ] ifFalse:[
  3351             ] ifFalse:[
  3224                 (menu := anItem basicGetSubmenu) notNil ifTrue:[
  3352                 (menu := anItem currentSubmenu) notNil ifTrue:[
  3225                     seq := menu selectItemsForShortcutKey:aKey maxDepth:maxDepth-1
  3353                     seq := menu selectItemsForShortcutKey:aKey maxDepth:maxDepth-1
  3226                 ]
  3354                 ]
  3227             ].
  3355             ].
  3228             seq notNil ifTrue:[
  3356             seq notNil ifTrue:[
  3229                 seq addFirst:anItem.
  3357                 seq addFirst:anItem.
  3492     (item := selection) notNil ifTrue:[
  3620     (item := selection) notNil ifTrue:[
  3493         selection := nil.
  3621         selection := nil.
  3494         item selected:false.
  3622         item selected:false.
  3495     ].
  3623     ].
  3496     newSel notNil ifTrue:[
  3624     newSel notNil ifTrue:[
  3497         self pointerEntersItem:nil.
  3625         newSel == enteredItem ifTrue:[
       
  3626             enteredItem := nil
       
  3627         ] ifFalse:[
       
  3628             self pointerEntersItem:nil
       
  3629         ].
  3498         selection := newSel.
  3630         selection := newSel.
  3499 
  3631 
  3500         ActiveHelp isActive ifTrue:[
  3632         ActiveHelp isActive ifTrue:[
  3501             hlp := ActiveHelp currentHelpListener.
  3633             hlp := ActiveHelp currentHelpListener.
  3502             hlp initiateHelpFor:self atX:nil y:nil now:true.
  3634             hlp initiateHelpFor:self atX:nil y:nil now:true.
  3532 
  3664 
  3533 labelRightOffset
  3665 labelRightOffset
  3534     ^ LabelRightOffset
  3666     ^ LabelRightOffset
  3535 !
  3667 !
  3536 
  3668 
  3537 shortcutKeyOffset
       
  3538     ^ ShortcutKeyOffset
       
  3539 !
       
  3540 
       
  3541 verticalInset
  3669 verticalInset
  3542     ^ VerticalInset
  3670     ^ VerticalInset
  3543 ! !
  3671 ! !
  3544 
  3672 
  3545 !MenuPanel::Item class methodsFor:'defaults'!
  3673 !MenuPanel::Item class methodsFor:'defaults'!
  3559 
  3687 
  3560     HorizontalButtonInset := 3.
  3688     HorizontalButtonInset := 3.
  3561     VerticalButtonInset   := 3.
  3689     VerticalButtonInset   := 3.
  3562 
  3690 
  3563     LabelRightOffset      := 15.
  3691     LabelRightOffset      := 15.
  3564     ShortcutKeyOffset     := 5.
       
  3565 
       
  3566     IndicatorOn  := self checkedImage.
       
  3567     IndicatorOff := self uncheckedImage.
       
  3568 ! !
       
  3569 
       
  3570 !MenuPanel::Item class methodsFor:'image specs'!
       
  3571 
       
  3572 checkOffIcon
       
  3573     "This resource specification was automatically generated
       
  3574      by the ImageEditor of ST/X."
       
  3575 
       
  3576     "Do not manually edit this!! If it is corrupted,
       
  3577      the ImageEditor may not be able to read the specification."
       
  3578 
       
  3579     "
       
  3580      self checkOffIcon inspect
       
  3581      ImageEditor openOnClass:self andSelector:#checkOffIcon
       
  3582     "
       
  3583 
       
  3584     <resource: #image>
       
  3585 
       
  3586     ^Icon
       
  3587 	constantNamed:#'MenuPanel::Item checkOffIcon'
       
  3588 	ifAbsentPut:[(Depth2Image new) width: 15; height: 15; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@AUP@@E@AP@DO?Y@D_?>(AO??;AO???LS???3D???<1O???LS???3A_??3@Z??<0A+?00@C@C0@@O?@@') ; colorMapFromArray:#[0 0 0 85 85 85 170 170 170 255 255 255]; mask:((Depth1Image new) width: 15; height: 15; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'A<@_<C?8_?1??O?:??+?>/?:??)?=G?4O< HL@_@') ; yourself); yourself]!
       
  3589 
       
  3590 checkOnIcon
       
  3591     "This resource specification was automatically generated
       
  3592      by the ImageEditor of ST/X."
       
  3593 
       
  3594     "Do not manually edit this!! If it is corrupted,
       
  3595      the ImageEditor may not be able to read the specification."
       
  3596 
       
  3597     "
       
  3598      self checkOnIcon inspect
       
  3599      ImageEditor openOnClass:self andSelector:#checkOnIcon
       
  3600     "
       
  3601 
       
  3602     <resource: #image>
       
  3603 
       
  3604     ^Icon
       
  3605 	constantNamed:#'MenuPanel::Item checkOnIcon'
       
  3606 	ifAbsentPut:[(Depth2Image new) width: 15; height: 15; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@AUP@@E@AP@DO?Y@D]@^(AL@@;AM@@GLS@@@3D0@@L1L@@CLSP@A3A\@@3@Z4A<0A+?00@C@C0@@O?@@') ; colorMapFromArray:#[0 0 0 85 85 85 170 170 170 255 255 255]; mask:((Depth1Image new) width: 15; height: 15; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'A<@_<C?8_?1??O?:??+?>/?:??)?=G?4O< HL@_@') ; yourself); yourself]!
       
  3607 
       
  3608 checkedImage
       
  3609     "This resource specification was automatically generated
       
  3610      by the ImageEditor of ST/X."
       
  3611 
       
  3612     "Do not manually edit this!! If it is corrupted,
       
  3613      the ImageEditor may not be able to read the specification."
       
  3614 
       
  3615     "
       
  3616      self checkedImage inspect
       
  3617      ImageEditor openOnClass:self andSelector:#checkedImage
       
  3618     "
       
  3619 
       
  3620     <resource: #image>
       
  3621 
       
  3622     ^Icon
       
  3623 	constantNamed:#'MenuPanel::Item checkedImage'
       
  3624 	ifAbsentPut:[(Depth2Image new) width: 14; height: 14; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'****$H@@@MBEUUWP!!UUU4HUUT]BEUTGP!!ETA4HPTA]BD@AWP!!PAU4HUAU]BEUUWP/???4EUUUU@b') ; colorMapFromArray:#[0 0 0 255 255 255 127 127 127 170 170 170]; mask:((Depth1Image new) width: 14; height: 14; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'??3??O?<??3??O?<??3??O?<??3??O?<??3??@@a') ; yourself); yourself]
       
  3625 
       
  3626     "Modified: / 6.9.1998 / 22:29:58 / cg"
       
  3627 !
       
  3628 
       
  3629 uncheckedImage
       
  3630     "This resource specification was automatically generated
       
  3631      by the ImageEditor of ST/X."
       
  3632 
       
  3633     "Do not manually edit this!! If it is corrupted,
       
  3634      the ImageEditor may not be able to read the specification."
       
  3635 
       
  3636     "
       
  3637      self uncheckedImage inspect
       
  3638      ImageEditor openOnClass:self andSelector:#uncheckedImage
       
  3639     "
       
  3640 
       
  3641     <resource: #image>
       
  3642 
       
  3643     ^Icon
       
  3644 	constantNamed:#'MenuPanel::Item uncheckedImage'
       
  3645 	ifAbsentPut:[(Depth2Image new) width: 14; height: 14; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'UUUUPG???8A0@@B@\@@@ G@@@HA0@@B@\@@@ G@@@HA0@@B@\@@@ G@@@HA0@@B@Z*** @@@@@@b') ; colorMapFromArray:#[255 255 255 127 127 127 170 170 170 0 0 0]; mask:((Depth1Image new) width: 14; height: 14; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'??3??O?<??3??O?<??3??O?<??3??O?<??3??@@a') ; yourself); yourself]
       
  3646 
       
  3647     "Modified: / 6.9.1998 / 22:24:24 / cg"
       
  3648 ! !
  3692 ! !
  3649 
  3693 
  3650 !MenuPanel::Item class methodsFor:'instance creation'!
  3694 !MenuPanel::Item class methodsFor:'instance creation'!
  3651 
  3695 
  3652 in:aSuperMenu
  3696 in:aSuperMenu
  3678 !
  3722 !
  3679 
  3723 
  3680 toggleIndication
  3724 toggleIndication
  3681     "toggle indication or choice
  3725     "toggle indication or choice
  3682     "
  3726     "
  3683     |arg choiceHolder|
  3727     |arg|
  3684 
  3728 
  3685     self indication notNil ifTrue:[    
  3729     indication notNil ifTrue:[    
  3686         arg := self indicationValue not.
  3730         arg := self indicationValue not.
  3687         self indicationValue:arg.
  3731         self indicationValue:arg.
  3688     ] ifFalse:[
  3732     ] ifFalse:[
  3689         (choiceHolder := self choice) notNil ifTrue:[
  3733         choice notNil ifTrue:[
  3690             arg := self choiceValue.
  3734             choice value:choiceValue.
  3691             choiceHolder value:arg.
       
  3692           ^ true
  3735           ^ true
  3693         ]
  3736         ]
  3694     ].
  3737     ].
  3695     ^ arg
  3738     ^ arg
  3696 ! !
  3739 ! !
  3698 !MenuPanel::Item methodsFor:'accessing'!
  3741 !MenuPanel::Item methodsFor:'accessing'!
  3699 
  3742 
  3700 accessCharacter
  3743 accessCharacter
  3701     "returns my accessCharacter or nil
  3744     "returns my accessCharacter or nil
  3702     "
  3745     "
  3703     accessCharacterPosition isNil ifTrue:[
  3746     ^ accessCharacter
  3704 	^ nil
       
  3705     ].
       
  3706   ^ (rawLabel string) at:accessCharacterPosition ifAbsent:nil
       
  3707 !
  3747 !
  3708 
  3748 
  3709 accessCharacterPosition
  3749 accessCharacterPosition
  3710     "get the access character position or nil
  3750     "get the access character position or nil
  3711     "
  3751     "
  3712   ^ accessCharacterPosition
  3752     ^ accessCharacterPosition
  3713 !
  3753 !
  3714 
  3754 
  3715 accessCharacterPosition:anIndex
  3755 accessCharacterPosition:anIndex 
  3716     "set the access character position or nil
  3756     "set the access character position or nil
  3717     "
  3757     "
  3718     accessCharacterPosition ~~ anIndex ifTrue:[
  3758     accessCharacterPosition := anIndex.
  3719 	accessCharacterPosition := anIndex.
       
  3720 	self updateRawLabel.
       
  3721     ].
       
  3722 !
  3759 !
  3723 
  3760 
  3724 argument
  3761 argument
  3725     "gets the argument
  3762     "gets the argument
  3726     "
  3763     "
  3727     adornment isNil ifTrue:[^ nil ].
  3764     ^ argument
  3728   ^ adornment argument
       
  3729 !
  3765 !
  3730 
  3766 
  3731 argument:anArgument
  3767 argument:anArgument
  3732     "sets the argument
  3768     "sets the argument
  3733     "
  3769     "
  3734     (anArgument notNil or:[adornment notNil]) ifTrue:[
  3770     argument := anArgument.
  3735         self adornment argument:anArgument.
       
  3736     ]
       
  3737 
       
  3738     "Modified: / 4.2.2000 / 12:41:00 / cg"
       
  3739 !
       
  3740 
       
  3741 basicGetSubmenu
       
  3742     "returns my submenu or nil
       
  3743     "
       
  3744     ^ subMenu
       
  3745 !
       
  3746 
       
  3747 compareAccessCharacterWith:aKey
       
  3748     "returns true if key is my access character
       
  3749     "
       
  3750     ^ self accessCharacter == aKey
       
  3751 
       
  3752 !
  3771 !
  3753 
  3772 
  3754 currentSubmenu
  3773 currentSubmenu
  3755     "returns the current submenu or nil
  3774     "returns the current submenu or nil
  3756     "
  3775     "
  3765 
  3784 
  3766 label:aLabel
  3785 label:aLabel
  3767     "set a new label; if the label changed, a redraw is performed;
  3786     "set a new label; if the label changed, a redraw is performed;
  3768      handle characters $& (ST-80 compatibility)
  3787      handle characters $& (ST-80 compatibility)
  3769     "
  3788     "
  3770     |i rest s|
  3789     |size char lbl
  3771 
  3790      h "{ Class:SmallInteger }"
  3772     accessCharacterPosition := nil.
  3791      w "{ Class:SmallInteger }"
  3773     label := aLabel value.
  3792     |
  3774 
  3793     accessCharacter := rawLabelExtent := disabledRawLabel := nil.
  3775     (label isString and:[(s := label size) > 1]) ifTrue:[
  3794     label    := aLabel value.
  3776 	i := 1.
  3795     rawLabel := label value ? ''.
  3777 
  3796 
  3778 	[((i := label indexOf:$& startingAt:i) ~~ 0 
  3797     rawLabel isString ifTrue:[
  3779 	and:[i < s])] whileTrue:[
  3798         "CHECK FOR SEPARATOR"
  3780 	    rest := label copyFrom:(i+1).
  3799 
  3781 
  3800         (isButton not and:[indication isNil and:[choice isNil]]) ifTrue:[
  3782 	    i == 1 ifTrue:[label := rest]
  3801             size := rawLabel size.
  3783 		  ifFalse:[label := (label copyFrom:1 to:(i-1)), rest].
  3802 
  3784 
  3803             size == 0 ifTrue:[
  3785 	    (label at:i) == $& ifTrue:[i := i + 1]
  3804                 rawLabel := nil.                        "blank separator"
  3786 			      ifFalse:[accessCharacterPosition := i].
  3805               ^ self
  3787 	    s := s - 1.
  3806             ].
  3788 	]
  3807 
  3789     ].
  3808             size == 1 ifTrue:[
  3790 
  3809                 char := rawLabel first.
  3791     self updateRawLabel
  3810 
  3792 
  3811                 (char == $- or:[char == $=]) ifTrue:[
  3793     "Modified: / 31.7.1998 / 00:52:26 / cg"
  3812                     label    := rawLabel.               "line separator"
       
  3813                     rawLabel := nil.
       
  3814                   ^ self
       
  3815                 ]
       
  3816             ]
       
  3817         ]
       
  3818     ] ifFalse:[
       
  3819         rawLabel isCollection ifTrue:[
       
  3820             rawLabel := rawLabel asArray.
       
  3821         ]
       
  3822     ].
       
  3823     rawLabel isArray ifTrue:[
       
  3824         w := h := 0.
       
  3825 
       
  3826         rawLabel keysAndValuesDo:[:i :el|
       
  3827             el notNil ifTrue:[
       
  3828                 lbl := self updateAccessCharacterFor:el.
       
  3829                 rawLabel at:i put:lbl.
       
  3830                 w := w max:(lbl widthOn:menuPanel).
       
  3831                 h := h + 1 + (lbl heightOn:menuPanel).
       
  3832             ] ifFalse:[
       
  3833                 h := h + 3
       
  3834             ]
       
  3835         ]
       
  3836     ] ifFalse:[
       
  3837         rawLabel := self updateAccessCharacterFor:rawLabel.
       
  3838         w := rawLabel  widthOn:menuPanel.
       
  3839         h := rawLabel heightOn:menuPanel.
       
  3840     ].
       
  3841     rawLabelExtent := w@h.
       
  3842 
       
  3843     menuPanel shown ifTrue:[ self fetchImages ].
       
  3844     menuPanel mustRearrange
  3794 !
  3845 !
  3795 
  3846 
  3796 menuPanel
  3847 menuPanel
  3797     "returns my menuPanel
  3848     "returns my menuPanel
  3798     "
  3849     "
  3828     "set the key to press to select the submenu from the keyboard or if
  3879     "set the key to press to select the submenu from the keyboard or if
  3829      no submenu exists evaluate the action assigned to the item (accept).
  3880      no submenu exists evaluate the action assigned to the item (accept).
  3830     "
  3881     "
  3831     shortcutKey ~~ aKey ifTrue:[
  3882     shortcutKey ~~ aKey ifTrue:[
  3832         shortcutKey := aKey.
  3883         shortcutKey := aKey.
  3833         menuPanel invalidateItem:self repairNow:false.
  3884         self invalidate.
  3834     ].
  3885     ].
  3835 !
  3886 !
  3836 
  3887 
  3837 startGroup
  3888 startGroup
  3838     "start group #left #right #center ... or nil
  3889     "start group #left #right #center ... or nil
  3843 
  3894 
  3844 startGroup:aSymbol
  3895 startGroup:aSymbol
  3845     "start group #left #right #center ...
  3896     "start group #left #right #center ...
  3846      at the moment only #right is implemented
  3897      at the moment only #right is implemented
  3847     "
  3898     "
  3848     (startGroup isNil or:[startGroup == #right]) ifTrue:[
  3899     startGroup := aSymbol.
  3849 	startGroup := aSymbol
       
  3850     ] ifFalse:[
       
  3851 	self warn:('not supported group: ', aSymbol printString ).
       
  3852     ]
       
  3853 
       
  3854 !
  3900 !
  3855 
  3901 
  3856 submenu
  3902 submenu
  3857     "returns my submenu or nil
  3903     "returns my submenu or nil
  3858     "
  3904     "
  3888 !
  3934 !
  3889 
  3935 
  3890 textLabel
  3936 textLabel
  3891     "returns my textLabel or nil if none text
  3937     "returns my textLabel or nil if none text
  3892     "
  3938     "
  3893     ^ rawLabel perform:#string ifNotUnderstood:nil
  3939     |txt|
       
  3940 
       
  3941     rawLabel notNil ifTrue:[
       
  3942         rawLabel isArray ifFalse:[
       
  3943             ^ rawLabel perform:#string ifNotUnderstood:nil
       
  3944         ].
       
  3945 
       
  3946         rawLabel do:[:el|
       
  3947             (txt := el perform:#string ifNotUnderstood:nil) notNil ifTrue:[
       
  3948                 ^ txt
       
  3949             ]
       
  3950         ].
       
  3951     ].
       
  3952     ^ nil
  3894 
  3953 
  3895 !
  3954 !
  3896 
  3955 
  3897 value
  3956 value
  3898     "gets value
  3957     "gets value
  3907 !
  3966 !
  3908 
  3967 
  3909 value:aValue argument:anArgument
  3968 value:aValue argument:anArgument
  3910     "set the value and an argument
  3969     "set the value and an argument
  3911     "
  3970     "
  3912     self value:aValue.
  3971     value    := aValue.
  3913     self argument:anArgument.
  3972     argument := anArgument.
  3914 ! !
  3973 ! !
  3915 
  3974 
  3916 !MenuPanel::Item methodsFor:'accessing-behavior'!
  3975 !MenuPanel::Item methodsFor:'accessing-behavior'!
  3917 
  3976 
  3918 choice
  3977 choice
  3919     "get choice indication
  3978     "implements a radio group; the field
  3920     "
  3979     "
  3921     adornment isNil ifTrue:[^ nil].
  3980     ^ choice
  3922   ^ adornment choice
  3981 
  3923 
       
  3924     "Created: / 14.8.1998 / 14:38:52 / cg"
       
  3925 !
  3982 !
  3926 
  3983 
  3927 choice:something
  3984 choice:something
  3928     "set choice indication
  3985     "set choice indication
  3929     "
  3986     "
  3930     |old new|
  3987     choice == something ifTrue:[^ self].
  3931 
  3988 
  3932     old := self choice.
  3989     choice isValueModel ifTrue:[
  3933     old == something ifTrue:[^ self].
  3990         choice removeDependent:self
  3934 
  3991     ].
  3935     old isValueModel ifTrue:[
  3992 
  3936         old removeDependent:self
  3993     (choice := something) notNil ifTrue:[
  3937     ].
  3994         choice isSymbol ifTrue:[
  3938 
  3995             (choice := self aspectAt:choice) isNil ifTrue:[
  3939     new := something.
  3996                 choice := something
  3940     new isSymbol ifTrue:[
  3997             ]
  3941         new := self aspectAt:new.
  3998         ].
  3942         new isNil ifTrue:[
  3999         choice isValueModel ifTrue:[
  3943             new := something
  4000             choice addDependent:self
  3944         ]
  4001         ]
  3945     ].
  4002     ].
  3946     new isValueModel ifTrue:[
       
  3947         new addDependent:self
       
  3948     ].
       
  3949     self adornment choice:new.
       
  3950     self updateRawLabel.
       
  3951 
       
  3952     "Created: / 14.8.1998 / 14:39:11 / cg"
       
  3953     "Modified: / 14.8.1998 / 16:13:19 / cg"
       
  3954 !
  4003 !
  3955 
  4004 
  3956 choiceValue
  4005 choiceValue
  3957     "get choice value
  4006     "implements a radio group; the value writen to the choice if selected
  3958     "
  4007     "
  3959     adornment isNil ifTrue:[^ nil].
  4008     ^ choiceValue
  3960   ^ adornment choiceValue
  4009 
  3961 
       
  3962     "Created: / 14.8.1998 / 15:46:33 / cg"
       
  3963 !
  4010 !
  3964 
  4011 
  3965 choiceValue:something
  4012 choiceValue:something
  3966     "set choice value
  4013     "implements a radio group; the value writen to the choice if selected
  3967     "
  4014     "
  3968     (something notNil or:[adornment notNil]) ifTrue:[
  4015     choiceValue ~= something ifTrue:[
  3969         self adornment choiceValue:something.
  4016         choiceValue := something.
  3970         self updateRawLabel.
  4017 
  3971     ]
  4018         choice notNil ifTrue:[
  3972 
  4019             self invalidate
  3973     "Created: / 14.8.1998 / 15:46:59 / cg"
  4020         ]
  3974     "Modified: / 4.2.2000 / 12:41:45 / cg"
  4021     ].
  3975 !
  4022 !
  3976 
  4023 
  3977 enabled
  4024 enabled
  3978     "returns the enabled state
  4025     "returns the enabled state
  3979     "
  4026     "
  4025         menuPanel shown ifFalse:[^ self].
  4072         menuPanel shown ifFalse:[^ self].
  4026         newState := enableChannel value.
  4073         newState := enableChannel value.
  4027     ].
  4074     ].
  4028 
  4075 
  4029     newState ~~ oldState ifTrue:[
  4076     newState ~~ oldState ifTrue:[
  4030         rawLabel notNil ifTrue:[
  4077         self invalidate
  4031             menuPanel invalidateItem:self repairNow:false
       
  4032         ]
       
  4033     ].
  4078     ].
  4034 !
  4079 !
  4035 
  4080 
  4036 hideMenuOnActivated
  4081 hideMenuOnActivated
  4037     "hide the menu when the item was activated; the default is true
  4082     "hide the menu when the item was activated; the default is true
  4041 !
  4086 !
  4042 
  4087 
  4043 hideMenuOnActivated:aBool
  4088 hideMenuOnActivated:aBool
  4044    "hide the menu when the item was activated; the default is true
  4089    "hide the menu when the item was activated; the default is true
  4045    "
  4090    "
  4046    hideMenuOnActivated := aBool ? true.
  4091    hideMenuOnActivated := aBool.
  4047 
  4092 
  4048 
  4093 
  4049 !
  4094 !
  4050 
  4095 
  4051 indication
  4096 indication
  4052     "get on/off indication
  4097     "get on/off indication
  4053     "
  4098     "
  4054     adornment isNil ifTrue:[^ nil].
  4099     ^ indication
  4055   ^ adornment indication
       
  4056 !
  4100 !
  4057 
  4101 
  4058 indication:something
  4102 indication:something
  4059     "set on/off indication
  4103     "set on/off indication
  4060     "
  4104     "
  4061     |old|
  4105     indication == something ifTrue:[^ self].
  4062 
  4106 
  4063     old := self indication.
  4107     indication isValueModel ifTrue:[
  4064     old == something ifTrue:[^ self].
  4108         indication removeDependent:self
  4065 
  4109     ].
  4066     old isValueModel ifTrue:[
  4110 
  4067         old removeDependent:self
  4111     (indication := something) notNil ifTrue:[
  4068     ].
  4112         indication isValueModel ifTrue:[
  4069 
  4113             indication addDependent:self
  4070     something isValueModel ifTrue:[
  4114         ] ifFalse:[
  4071         something addDependent:self
  4115             "/ to force an update of the value
  4072     ].
  4116             self indicationValue
  4073     self adornment indication:something.
  4117         ]
  4074     self updateRawLabel.
  4118     ].
  4075 !
  4119 !
  4076 
  4120 
  4077 isButton
  4121 isButton
  4078     "returns whether item looks like a Button
  4122     "returns whether item looks like a Button
  4079     "
  4123     "
  4093 
  4137 
  4094 !
  4138 !
  4095 
  4139 
  4096 showBusyCursorWhilePerforming
  4140 showBusyCursorWhilePerforming
  4097     "get the flag which controls if a busy cursor is to be shown
  4141     "get the flag which controls if a busy cursor is to be shown
  4098      while performing the menu action. Defaults to false."
  4142      while performing the menu action. Defaults to false.
  4099 
  4143     "
  4100     adornment isNil ifTrue:[^ false ].
  4144     ^ showBusyCursorWhilePerforming ? false
  4101   ^ adornment showBusyCursorWhilePerforming
       
  4102 
  4145 
  4103 
  4146 
  4104 !
  4147 !
  4105 
  4148 
  4106 showBusyCursorWhilePerforming:aBoolean
  4149 showBusyCursorWhilePerforming:aBoolean
  4107     "set/clear the flag which controls if a busy cursor is to be shown
  4150     "set/clear the flag which controls if a busy cursor is to be shown
  4108      while performing the menu action. Defaults to false."
  4151      while performing the menu action. Defaults to false.
  4109 
  4152     "
  4110     ((aBoolean == true) or:[adornment notNil]) ifTrue:[
  4153     showBusyCursorWhilePerforming := aBoolean.
  4111         self adornment showBusyCursorWhilePerforming:aBoolean.
       
  4112     ]
       
  4113 
       
  4114 
       
  4115 !
  4154 !
  4116 
  4155 
  4117 submenuChannel
  4156 submenuChannel
  4118     "get the submenu channel
  4157     "get the submenu channel
  4119     "
  4158     "
  4136 
  4175 
  4137 layout:aLayout
  4176 layout:aLayout
  4138     "set a new layout ( Rectangle )
  4177     "set a new layout ( Rectangle )
  4139     "
  4178     "
  4140     layout := aLayout.
  4179     layout := aLayout.
  4141     menuPanel invalidateItem:self repairNow:false.
  4180     self invalidate.
  4142 
  4181 
  4143 !
  4182 !
  4144 
  4183 
  4145 preferredExtent
  4184 preferredExtent
  4146     "compute my preferred extent excluding the shortCutKey and the menu identifier
  4185     "compute my preferred extent excluding the shortCutKey and the menu identifier
  4176         ] ifTrue:[
  4215         ] ifTrue:[
  4177             y := y max:s.
  4216             y := y max:s.
  4178             x := x + 5.
  4217             x := x + 5.
  4179         ].
  4218         ].
  4180     ] ifFalse:[
  4219     ] ifFalse:[
  4181         x := x + (rawLabel  widthOn:menuPanel).
  4220         x := x + rawLabelExtent x.
  4182         y := y + (rawLabel heightOn:menuPanel).
  4221         y := y + rawLabelExtent y.
  4183 
  4222 
  4184         (isButton not and:[menuPanel showSeparatingLines]) ifTrue:[
  4223         isButton ifFalse:[
  4185             "width of separator is 2 plus right offset 1 := 3"
  4224             menuPanel showSeparatingLines ifTrue:[
  4186             isVertical ifFalse:[x := x + 3] ifTrue:[y := y + 3].
  4225                 "width of separator is 2 plus right offset 1 := 3"
       
  4226                 isVertical ifFalse:[x := x + 3] ifTrue:[y := y + 3].
       
  4227             ].
       
  4228             (indication notNil or:[choice notNil]) ifTrue:[
       
  4229                 x := x + 2 + menuPanel iconIndicationOff width.
       
  4230             ].
  4187         ]
  4231         ]
  4188     ].
  4232     ].
  4189     ^ x@y
  4233     ^ x@y
  4190 ! !
  4234 ! !
  4191 
  4235 
  4355     "Modified: / 29.7.1998 / 11:59:50 / cg"
  4399     "Modified: / 29.7.1998 / 11:59:50 / cg"
  4356 ! !
  4400 ! !
  4357 
  4401 
  4358 !MenuPanel::Item methodsFor:'change & update'!
  4402 !MenuPanel::Item methodsFor:'change & update'!
  4359 
  4403 
  4360 choiceChanged
       
  4361     "called when the choice changed
       
  4362     "
       
  4363     |indicator|
       
  4364 
       
  4365     isButton ifFalse:[
       
  4366         indicator := self choiceForm.
       
  4367 
       
  4368         indicator = rawLabel icon ifTrue:[
       
  4369             ^ self
       
  4370         ].
       
  4371         rawLabel icon:indicator.
       
  4372 
       
  4373         disabledRawLabel notNil ifTrue:[
       
  4374             disabledRawLabel icon:indicator
       
  4375         ]
       
  4376     ].
       
  4377     menuPanel invalidateItem:self repairNow:false.
       
  4378 
       
  4379 !
       
  4380 
       
  4381 indicationChanged
       
  4382     "called when the indication changed
       
  4383     "
       
  4384     |indicator|
       
  4385 
       
  4386     isButton ifFalse:[
       
  4387         indicator := self indicatorForm.
       
  4388 
       
  4389         indicator = rawLabel icon ifTrue:[
       
  4390             ^ self
       
  4391         ].
       
  4392         rawLabel icon:indicator.
       
  4393 
       
  4394         disabledRawLabel notNil ifTrue:[
       
  4395             disabledRawLabel icon:indicator
       
  4396         ]
       
  4397     ].
       
  4398     menuPanel invalidateItem:self repairNow:false
       
  4399 !
       
  4400 
       
  4401 update:something with:aParameter from:changedObject
  4404 update:something with:aParameter from:changedObject
  4402 
  4405 
  4403     rawLabel notNil ifTrue:[
  4406     |form rect|
       
  4407 
       
  4408     (menuPanel isNil or:[layout isNil]) ifTrue:[^ self].        "/ not yet realized or computed
       
  4409 
       
  4410     self isSeparator ifFalse:[
  4404         "/ NOT A SEPARATOR
  4411         "/ NOT A SEPARATOR
  4405 
  4412 
  4406         changedObject == self indication ifTrue:[
  4413         menuPanel shown ifTrue:[
  4407             ^ self indicationChanged
  4414             changedObject == enableChannel ifTrue:[
  4408         ].
  4415                 ^ self invalidate
  4409 
  4416             ].
  4410         changedObject == self choice ifTrue:[
  4417 
  4411             ^ self choiceChanged
  4418             (changedObject == indication or:[changedObject == choice]) ifTrue:[
  4412         ].
  4419                 isButton ifTrue:[
  4413         changedObject == enableChannel ifTrue:[
  4420                     self invalidate
  4414             ^ menuPanel invalidateItem:self repairNow:false
  4421                 ] ifFalse:[
  4415         ]
  4422                     "/ invalidate the interactor only
       
  4423                     "/ take any interactor; interactors has the same extent
       
  4424                     form := menuPanel iconIndicationOff.
       
  4425 
       
  4426                     rect := Rectangle left:(layout left + HorizontalInset)
       
  4427                                        top:(layout top)
       
  4428                                      width:(form width)
       
  4429                                     height:(layout height).
       
  4430 
       
  4431                     menuPanel invalidate:rect repairNow:false
       
  4432                 ].
       
  4433                 ^ self
       
  4434             ].
       
  4435         ].
  4416     ].
  4436     ].
  4417 
  4437 
  4418     changedObject == isVisible ifTrue:[
  4438     changedObject == isVisible ifTrue:[
  4419         menuPanel mustRearrange.
  4439         menuPanel mustRearrange.
  4420         menuPanel rearrangeItems.
  4440         menuPanel rearrangeItems.
  4425 !
  4445 !
  4426 
  4446 
  4427 updateIndicators
  4447 updateIndicators
  4428     "update indicators
  4448     "update indicators
  4429     "
  4449     "
  4430     |indicator| 
  4450     (indication notNil and:[indication isSymbol]) ifTrue:[
  4431 
  4451         " indication is a selector otherwise a change notification
  4432     indicator := self indication.
       
  4433 
       
  4434     (indicator notNil and:[indicator isSymbol]) ifTrue:[
       
  4435         " indicator is a selector otherwise a change notification
       
  4436           is raised from the model !!!!
  4452           is raised from the model !!!!
  4437         "
  4453         "
  4438         self indicationChanged        
  4454         self update:nil with:nil from:indication
  4439     ]
  4455     ]
  4440 ! !
  4456 ! !
  4441 
  4457 
  4442 !MenuPanel::Item methodsFor:'converting'!
  4458 !MenuPanel::Item methodsFor:'converting'!
  4443 
  4459 
  4460 
  4476 
  4461     enableChannel notNil ifTrue:[
  4477     enableChannel notNil ifTrue:[
  4462         item enabled:(enableChannel value)
  4478         item enabled:(enableChannel value)
  4463     ].
  4479     ].
  4464 
  4480 
  4465     item accessCharacterPosition:(self accessCharacterPosition).
  4481     item accessCharacterPosition:accessCharacterPosition.
  4466     item startGroup:(self startGroup).
  4482     item startGroup:startGroup.
  4467     item argument:(self argument).
  4483     item argument:argument.
  4468     item nameKey:(self nameKey).
  4484     item nameKey:nameKey.
  4469     item shortcutKeyCharacter:shortcutKey.
  4485     item shortcutKeyCharacter:shortcutKey.
  4470     item value:(value value).
  4486     item value:(value value).
  4471     item indication:(self indication value).
  4487     item indication:(indication value).
  4472     item choice:(self choice value).
  4488     item choice:(choice value).
  4473     item choiceValue:(self choiceValue).
  4489     item choiceValue:choiceValue.
  4474     item isVisible:(self isVisible).
  4490     item isVisible:(self isVisible).
  4475     item hideMenuOnActivated:(self hideMenuOnActivated).
  4491     item hideMenuOnActivated:(self hideMenuOnActivated).
  4476     item showBusyCursorWhilePerforming:(self showBusyCursorWhilePerforming).
  4492     item showBusyCursorWhilePerforming:(self showBusyCursorWhilePerforming).
  4477     item isButton:isButton.
  4493     item isButton:isButton.
  4478 
  4494 
  4489 !
  4505 !
  4490 
  4506 
  4491 menuItem:aMenuItem
  4507 menuItem:aMenuItem
  4492     "setup attributes from a MenuItem
  4508     "setup attributes from a MenuItem
  4493     "
  4509     "
  4494     |var lbl|
  4510     |lbl|
  4495 
  4511 
  4496     menuPanel disabledRedrawDo:[
  4512     menuPanel disabledRedrawDo:[
  4497         label := nil.
  4513         label := rawLabel := nil.
  4498         self activeHelpKey:(aMenuItem activeHelpKey).
  4514         accessCharacterPosition       := aMenuItem accessCharacterPosition.
  4499         self enabled:(aMenuItem enabled).
  4515         argument                      := aMenuItem argument.
  4500         self nameKey:(aMenuItem nameKey).
  4516         choiceValue                   := aMenuItem choiceValue.
       
  4517         showBusyCursorWhilePerforming := aMenuItem showBusyCursorWhilePerforming.
       
  4518         hideMenuOnActivated           := aMenuItem hideMenuOnActivated.
       
  4519         isButton                      := aMenuItem isButton ? false.
       
  4520         nameKey                       := aMenuItem nameKey.
       
  4521         startGroup                    := aMenuItem startGroup.
       
  4522         shortcutKey                   := aMenuItem shortcutKeyCharacter.
       
  4523         value                         := aMenuItem value.
       
  4524         activeHelpKey                 := aMenuItem activeHelpKey.
       
  4525         activeHelpText                := nil.
       
  4526 
       
  4527         self    enabled:(aMenuItem enabled).
  4501         self indication:(aMenuItem indication).
  4528         self indication:(aMenuItem indication).
  4502         self choice:(aMenuItem choice).
  4529         self     choice:(aMenuItem choice).
  4503         self choiceValue:(aMenuItem choiceValue).
  4530         self  isVisible:(aMenuItem isVisible).
  4504         self isButton:(aMenuItem isButton).
       
  4505         self startGroup:(aMenuItem startGroup).
       
  4506         self isVisible:(aMenuItem isVisible).
       
  4507         self hideMenuOnActivated:(aMenuItem hideMenuOnActivated).
       
  4508         self showBusyCursorWhilePerforming:(aMenuItem showBusyCursorWhilePerforming).
       
  4509 
  4531 
  4510         (lbl := aMenuItem labelImage value) isNil ifTrue:[
  4532         (lbl := aMenuItem labelImage value) isNil ifTrue:[
  4511             lbl := aMenuItem rawLabel. "/ avoid translating &'s twice
  4533             lbl := aMenuItem rawLabel. "/ avoid translating &'s twice
  4512         ].
  4534         ].
       
  4535 
  4513         self label:lbl.
  4536         self label:lbl.
  4514 
       
  4515         (var := aMenuItem accessCharacterPosition) notNil ifTrue:[
       
  4516             self accessCharacterPosition:var.
       
  4517         ].
       
  4518 
       
  4519         self shortcutKey:(aMenuItem shortcutKeyCharacter).
       
  4520 
       
  4521         (var := aMenuItem argument) notNil ifTrue:[
       
  4522             self argument:var.
       
  4523         ].
       
  4524 
       
  4525         submenuChannel := aMenuItem submenuChannel.
  4537         submenuChannel := aMenuItem submenuChannel.
  4526         self submenu:(aMenuItem submenu).
  4538         self submenu:(aMenuItem submenu).
  4527         self value:(aMenuItem value).
       
  4528     ]
  4539     ]
  4529 
  4540 
  4530     "Modified: / 22.8.1998 / 15:34:16 / cg"
  4541     "Modified: / 22.8.1998 / 15:34:16 / cg"
  4531 ! !
  4542 ! !
  4532 
  4543 
  4533 !MenuPanel::Item methodsFor:'drawing'!
  4544 !MenuPanel::Item methodsFor:'drawing'!
  4534 
  4545 
  4535 drawButton
  4546 drawButton
  4536     "draw as button
  4547     "draw as button
  4537     "
  4548     "
  4538     |drawObject fg level isSelected bg holder ownBgCol
  4549     |drawObject fg level isSelected bg ownBgCol
  4539      x "{ Class:SmallInteger }"
  4550      x "{ Class:SmallInteger }"
  4540      y "{ Class:SmallInteger }"
       
  4541     |
  4551     |
  4542     drawObject := rawLabel.
  4552     drawObject := rawLabel.
  4543 
  4553 
  4544     "COMPUTE COLORS"
  4554     "COMPUTE COLORS"
  4545     (isSelected := self isSelected) ifTrue:[
  4555     (isSelected := self isSelected) ifTrue:[
  4567     bg ~= menuPanel backgroundColor ifTrue:[
  4577     bg ~= menuPanel backgroundColor ifTrue:[
  4568         menuPanel paint:bg.
  4578         menuPanel paint:bg.
  4569         menuPanel fillRectangle:layout.
  4579         menuPanel fillRectangle:layout.
  4570     ].
  4580     ].
  4571 
  4581 
  4572     "DRAW LABEL"
       
  4573     menuPanel paint:fg.
       
  4574 
       
  4575     y := layout top  + ((layout height - (drawObject heightOn:menuPanel)) // 2).
       
  4576     x := layout left + menuPanel buttonPassiveLevel + HorizontalButtonInset.
  4582     x := layout left + menuPanel buttonPassiveLevel + HorizontalButtonInset.
  4577 
       
  4578     drawObject isImageOrForm ifFalse:[
       
  4579         y := y + menuPanel font ascent
       
  4580     ].
       
  4581 
  4583 
  4582     isSelected ifFalse:[
  4584     isSelected ifFalse:[
  4583         "check whether button should be drawn selected; indicator or radio button"
  4585         "check whether button should be drawn selected; indicator or radio button"
  4584 
  4586 
  4585         self indicationValue == true ifTrue:[
  4587         indication notNil ifTrue:[
  4586             "button is indicator and set"
  4588             "button is indicator and set"
  4587             isSelected := true
  4589             isSelected := self indicationValue
  4588         ]ifFalse:[
  4590         ] ifFalse:[
  4589             "check if part of radio button group and the active one"
  4591             isSelected := (choice notNil and:[choice value = choiceValue]).
  4590             isSelected := ((holder := self choice) notNil and:[holder value = self choiceValue]).
       
  4591         ]
  4592         ]
  4592     ].
  4593     ].
  4593 
  4594 
  4594     isSelected ifTrue:[   
  4595     isSelected ifTrue:[   
  4595         x := x + 1.
       
  4596         y := y + 1.
       
  4597         level := menuPanel buttonActiveLevel.
  4596         level := menuPanel buttonActiveLevel.
       
  4597         x     := x + level abs.
  4598     ] ifFalse:[   
  4598     ] ifFalse:[   
  4599         level := self isEntered ifTrue:[menuPanel buttonEnteredLevel]
  4599         level := self isEntered ifTrue:[menuPanel buttonEnteredLevel]
  4600                                ifFalse:[menuPanel buttonPassiveLevel].
  4600                                ifFalse:[menuPanel buttonPassiveLevel].
  4601     ].
  4601     ].
  4602     drawObject displayOn:menuPanel x:x y:y.
  4602     self drawRawLabel:drawObject atX:x paint:fg.
  4603 
  4603 
  4604     level ~~ 0 ifTrue:[
  4604     level ~~ 0 ifTrue:[
  4605         menuPanel drawButtonEdgesFor:self level:level
  4605         menuPanel drawButtonEdgesFor:self level:level
  4606     ].
  4606     ].
  4607 !
  4607 !
  4608 
  4608 
  4609 drawLabel
  4609 drawLabel
  4610     "draw a labeled entry; no button, no separator.
  4610     "draw a labeled entry; no button, no separator.
  4611     "
  4611     "
  4612     |scKey cLb cLa img fg arrow 
  4612     |scKey cLb cLa drawObject fg arrow 
  4613      buttonLevel isSelected
  4613      isSelected form
  4614      h "{ Class:SmallInteger }"
  4614      h "{ Class:SmallInteger }"
  4615      y "{ Class:SmallInteger }"
  4615      y "{ Class:SmallInteger }"
  4616      x "{ Class:SmallInteger }"
  4616      x "{ Class:SmallInteger }"
  4617      t "{ Class:SmallInteger }"
  4617      t "{ Class:SmallInteger }"
  4618      l "{ Class:SmallInteger }"
       
  4619     |
  4618     |
  4620     img := rawLabel.
  4619     drawObject := rawLabel.
  4621 
  4620 
  4622     (isSelected := self isSelected) ifTrue:[
  4621     (isSelected := self isSelected) ifTrue:[
  4623         fg := self activeForegroundColor
  4622         fg := self activeForegroundColor
  4624     ] ifFalse:[
  4623     ] ifFalse:[
  4625         self enabled ifTrue:[
  4624         self enabled ifTrue:[
  4626             fg := menuPanel foregroundColor
  4625             fg := menuPanel foregroundColor
  4627         ] ifFalse:[
  4626         ] ifFalse:[
  4628             fg  := menuPanel disabledForegroundColor.
  4627             fg  := menuPanel disabledForegroundColor.
  4629             img := self disabledRawLabel
  4628             drawObject := self disabledRawLabel
  4630         ]
  4629         ]
  4631     ].
  4630     ].
  4632 
  4631 
  4633     h := layout height.
  4632     h := layout height.
  4634     l := layout left.
  4633     x := layout left + HorizontalInset.
  4635     t := layout top.
  4634     t := layout top.
  4636     y := t + ((h - (img heightOn:menuPanel)) // 2).
  4635 
  4637 
  4636     ((form := self indicatorForm) notNil or:[(form := self choiceForm) notNil]) ifTrue:[
  4638     img isImageOrForm ifFalse:[
  4637         y := t + ((h - form height) // 2).
  4639         y := y + menuPanel font ascent
  4638         form displayOn:menuPanel x:x y:y.
  4640     ].
  4639         x := x + 2 + form width.
  4641 
  4640     ].
  4642     menuPanel paint:fg.
  4641 
  4643     img displayOn:menuPanel x:(l + HorizontalInset) y:y.
  4642     self drawRawLabel:drawObject atX:x paint:fg.
  4644 
  4643 
  4645     "/ DRAW SHORTCUT KEY
  4644     "/ DRAW SHORTCUT KEY
  4646 
  4645 
  4647     (shortcutKey notNil and:[MenuView showAcceleratorKeys == true]) ifTrue:[
  4646     (     shortcutKey notNil
  4648         menuPanel isVerticalLayout ifTrue:[ "/ only for vertical menus ...
  4647      and:[(x := menuPanel shortKeyInset) ~~ 0
  4649             (scKey:= self shortcutKeyAsString) notNil ifTrue:[
  4648      and:[(scKey:= self shortcutKeyAsString) notNil]]
  4650                 (x := menuPanel shortKeyInset) == 0 ifTrue:[
  4649     ) ifTrue:[
  4651                     x := HorizontalInset + LabelRightOffset + (img widthOn:menuPanel)
  4650         x := layout left + x.
  4652                 ].
  4651         y := t + ((h - (scKey heightOn:menuPanel)) // 2).
  4653                 x := l + x.
  4652         y := y + menuPanel font ascent.
  4654                 y := t + ((h - (scKey heightOn:menuPanel)) // 2).
  4653         scKey displayOn:menuPanel x:x y:y. 
  4655                 y := y + menuPanel font ascent.
       
  4656                 scKey displayOn:menuPanel x:x y:y. 
       
  4657             ].
       
  4658         ].
       
  4659     ].
  4654     ].
  4660 
  4655 
  4661     "/ DRAW SUBMENU INDICATION
  4656     "/ DRAW SUBMENU INDICATION
  4662 
  4657 
  4663     (menuPanel isVerticalLayout and:[self hasSubmenu]) ifTrue:[
  4658     (menuPanel isVerticalLayout and:[self hasSubmenu]) ifTrue:[
  4664         arrow := menuPanel rightArrow.
  4659         arrow := menuPanel rightArrow.
  4665         x := layout right - arrow width - HorizontalInset.
  4660         x := layout right - arrow width - HorizontalInset.
  4666         y := t + (h - arrow height // 2).
  4661         y := t + (h - arrow height // 2).
  4667 
  4662 
  4668         (menuPanel styleSheet is3D not
  4663         (menuPanel styleSheet is3D not
  4669         or:[(img := menuPanel rightArrowShadow) isNil]) ifTrue:[
  4664         or:[(drawObject := menuPanel rightArrowShadow) isNil]) ifTrue:[
  4670             ^ menuPanel displayForm:arrow x:x y:y
  4665             ^ menuPanel displayForm:arrow x:x y:y
  4671         ].
  4666         ].
  4672         cLa := menuPanel shadowColor.
  4667         cLa := menuPanel shadowColor.
  4673         cLb := menuPanel lightColor.
  4668         cLb := menuPanel lightColor.
  4674 
  4669 
  4678             cLb := fg
  4673             cLb := fg
  4679         ].
  4674         ].
  4680         menuPanel paint:cLa.
  4675         menuPanel paint:cLa.
  4681         menuPanel displayForm:arrow x:x y:y.
  4676         menuPanel displayForm:arrow x:x y:y.
  4682         menuPanel paint:cLb.
  4677         menuPanel paint:cLb.
  4683         menuPanel displayForm:img x:x y:y. 
  4678         menuPanel displayForm:drawObject x:x y:y. 
  4684     ]
  4679     ]
  4685 
  4680 
  4686     "Modified: / 6.9.1998 / 21:48:53 / cg"
  4681     "Modified: / 6.9.1998 / 21:48:53 / cg"
       
  4682 !
       
  4683 
       
  4684 drawRawLabel:aLabel atX:x paint:fg
       
  4685     "draw a labeled entry; no button, no separator.
       
  4686     "
       
  4687     |y  "{ Class:SmallInteger }"
       
  4688      y0 "{ Class:SmallInteger }"
       
  4689      x0 "{ Class:SmallInteger }"
       
  4690     |
       
  4691 
       
  4692     menuPanel paint:fg.
       
  4693 
       
  4694     y := layout top + (layout height - rawLabelExtent y // 2).
       
  4695 
       
  4696     aLabel isArray ifFalse:[
       
  4697         aLabel isImageOrForm ifFalse:[
       
  4698             y := y + menuPanel font ascent
       
  4699         ].
       
  4700         ^ aLabel displayOn:menuPanel x:x y:y.
       
  4701     ].
       
  4702 
       
  4703     aLabel do:[:el|
       
  4704         el notNil ifTrue:[
       
  4705             el isImageOrForm ifFalse:[
       
  4706                 y0 := y + menuPanel font ascent
       
  4707             ] ifTrue:[
       
  4708                 y0 := y
       
  4709             ].
       
  4710             x0 := x + (rawLabelExtent x - (el widthOn:menuPanel) // 2).
       
  4711             el displayOn:menuPanel x:x0 y:y0.
       
  4712             y := y + 1 + (el heightOn:menuPanel)
       
  4713         ] ifFalse:[
       
  4714             y := y + 3   "/ see #label:
       
  4715         ]
       
  4716     ].
  4687 !
  4717 !
  4688 
  4718 
  4689 drawSeparatingLines
  4719 drawSeparatingLines
  4690     "draw separating lines
  4720     "draw separating lines
  4691     "
  4721     "
  4777         isDouble ifTrue:[menuPanel displayLineFromX:x0+5 y:y0 toX:x0+5 y:y1].
  4807         isDouble ifTrue:[menuPanel displayLineFromX:x0+5 y:y0 toX:x0+5 y:y1].
  4778     ]
  4808     ]
  4779 
  4809 
  4780 !
  4810 !
  4781 
  4811 
       
  4812 invalidate
       
  4813 
       
  4814     (rawLabel notNil and:[menuPanel notNil]) ifTrue:[
       
  4815         menuPanel invalidateItem:self repairNow:false
       
  4816     ]
       
  4817 
       
  4818 
       
  4819 !
       
  4820 
  4782 redraw
  4821 redraw
  4783     "redraw item
  4822     "redraw item
  4784     "
  4823     "
  4785     |isSelected ownBgCol paint bgColor
  4824     |isSelected ownBgCol paint bgColor
  4786      x  "{ Class:SmallInteger }"
  4825      x  "{ Class:SmallInteger }"
  4837 !MenuPanel::Item methodsFor:'initialization'!
  4876 !MenuPanel::Item methodsFor:'initialization'!
  4838 
  4877 
  4839 destroy
  4878 destroy
  4840     "destroy submenus, remove dependencies
  4879     "destroy submenus, remove dependencies
  4841     "
  4880     "
  4842     |channel|
       
  4843 
       
  4844     self submenu:nil.
  4881     self submenu:nil.
  4845 
  4882 
  4846     enableChannel isValueModel ifTrue:[
  4883     enableChannel isValueModel ifTrue:[enableChannel removeDependent:self].
  4847         enableChannel removeDependent:self
  4884     isVisible     isValueModel  ifTrue:[isVisible    removeDependent:self].
  4848     ].
  4885     indication    isValueModel ifTrue:[indication    removeDependent:self].
  4849 
  4886     choice        isValueModel ifTrue:[choice        removeDependent:self].
  4850     isVisible isValueModel ifTrue:[
       
  4851         isVisible removeDependent:self
       
  4852     ].
       
  4853 
       
  4854     channel := self indication.
       
  4855     channel isValueModel ifTrue:[
       
  4856         channel removeDependent:self
       
  4857     ].
       
  4858 
       
  4859     channel := self choice.
       
  4860     channel isValueModel ifTrue:[
       
  4861         channel removeDependent:self
       
  4862     ].
       
  4863 
  4887 
  4864     menuPanel := nil.
  4888     menuPanel := nil.
  4865 
       
  4866     "Modified: / 14.8.1998 / 14:37:57 / cg"
       
  4867 !
  4889 !
  4868 
  4890 
  4869 in:aPanel
  4891 in:aPanel
  4870     "create item in a menuPanel
  4892     "create item in a menuPanel
  4871     "
  4893     "
  4876 !MenuPanel::Item methodsFor:'label basics'!
  4898 !MenuPanel::Item methodsFor:'label basics'!
  4877 
  4899 
  4878 disabledRawLabel
  4900 disabledRawLabel
  4879     "returns the label used if the item is disabled
  4901     "returns the label used if the item is disabled
  4880     "
  4902     "
  4881     disabledRawLabel isNil ifTrue:[
  4903     |block form image|
  4882 	(     rawImage notNil
  4904 
  4883 	 and:[(rawImage respondsTo:#colorMap)
  4905     disabledRawLabel notNil ifTrue:[^ disabledRawLabel].
  4884 	 and:[rawImage colorMap notNil]]
  4906 
  4885 	) ifFalse:[
  4907     disabledRawLabel := rawLabel ? ''.
  4886 	    disabledRawLabel := rawLabel.
  4908 
  4887 	] ifTrue:[
  4909     disabledRawLabel isString ifTrue:[
  4888 	    disabledRawLabel := menuPanel lightenedImageOnDevice:rawImage.
  4910         ^ disabledRawLabel
  4889 
  4911     ].
  4890 	    rawLabel class == LabelAndIcon ifTrue:[
  4912 
  4891 		(isButton
  4913     block := [:el| |rslt|
  4892 		  or:[((self indication notNil or:[self choice notNil])
  4914         (rslt := el) notNil ifTrue:[
  4893 		 and:[label class == LabelAndIcon])]
  4915             el isImageOrForm ifTrue:[
  4894 		) ifTrue:[
  4916                 el colorMap notNil ifTrue:[
  4895 		    disabledRawLabel := LabelAndIcon form:(rawLabel icon)
  4917                     rslt := menuPanel lightenedImageOnDevice:el
  4896 						    image:disabledRawLabel
  4918                 ]
  4897 						   string:(rawLabel string)
  4919             ] ifFalse:[
  4898 		] ifFalse:[
  4920                 el class == LabelAndIcon ifTrue:[
  4899 		    disabledRawLabel := LabelAndIcon form:disabledRawLabel
  4921                     ((form := el icon) notNil and:[form colorMap notNil]) ifTrue:[
  4900 						    image:(rawLabel image)
  4922                         form := menuPanel lightenedImageOnDevice:form
  4901 						   string:(rawLabel string)
  4923                     ].
  4902 		]
  4924                     ((image := el image) notNil and:[image colorMap notNil]) ifTrue:[
  4903 	    ]
  4925                         image := menuPanel lightenedImageOnDevice:image
  4904 	]
  4926                     ].
       
  4927                     rslt := LabelAndIcon form:form image:image string:(el string).
       
  4928                 ]
       
  4929             ]
       
  4930         ].
       
  4931         rslt
       
  4932     ].
       
  4933 
       
  4934     rawLabel isArray ifTrue:[
       
  4935         disabledRawLabel := Array new:(rawLabel size).
       
  4936 
       
  4937         rawLabel keysAndValuesDo:[:anIndex :aLabel|
       
  4938             disabledRawLabel at:anIndex put:(block value:aLabel)
       
  4939         ]
       
  4940     ] ifFalse:[
       
  4941         disabledRawLabel := block value:rawLabel
  4905     ].
  4942     ].
  4906     ^ disabledRawLabel
  4943     ^ disabledRawLabel
  4907 !
  4944 !
  4908 
  4945 
  4909 fetchImages
  4946 fetchImages
  4910     "fetch images
  4947     "fetch images
  4911     "
  4948     "
  4912     |icon|
  4949     |icon block|
  4913 
  4950 
  4914     rawImage notNil ifTrue:[
  4951     rawLabel notNil ifTrue:[
  4915 	rawLabel isImage ifTrue:[
  4952         block := [:el| |rslt|
  4916 	    rawLabel := menuPanel imageOnDevice:rawImage
  4953             (rslt := el) notNil ifTrue:[
  4917 	] ifFalse:[
  4954                 el isImageOrForm ifTrue:[
  4918 	    rawLabel class == LabelAndIcon ifTrue:[
  4955                     rslt := menuPanel imageOnDevice:el
  4919 		(icon := rawLabel image) notNil ifTrue:[
  4956                 ] ifFalse:[
  4920 		    rawLabel image:(menuPanel imageOnDevice:icon)
  4957                     el class == LabelAndIcon ifTrue:[
  4921 		].
  4958                         (icon := el image) notNil ifTrue:[
  4922 		(icon := rawLabel icon) notNil ifTrue:[
  4959                             el image:(menuPanel imageOnDevice:icon)
  4923 		    (self indication isNil and:[self choice isNil]) ifTrue:[
  4960                         ].
  4924 			rawLabel icon:(menuPanel imageOnDevice:icon)
  4961 
  4925 		    ]
  4962                         (icon := el icon) notNil ifTrue:[
  4926 		]
  4963                             el icon:(menuPanel imageOnDevice:icon)
  4927 	    ]
  4964                         ]
  4928 	]
  4965                     ]
  4929     ].
  4966                 ]
  4930 !
       
  4931 
       
  4932 updateRawLabel
       
  4933     "recreate rawLabel
       
  4934     "
       
  4935     |char size form|
       
  4936 
       
  4937     label isNil ifTrue:[        "/ not yet initialized
       
  4938         ^ self
       
  4939     ].
       
  4940 
       
  4941     (form := self indicatorForm) isNil ifTrue:[
       
  4942         form := self choiceForm
       
  4943     ].
       
  4944     rawImage         := nil.
       
  4945     disabledRawLabel := nil.
       
  4946     rawLabel         := label value.
       
  4947 
       
  4948     rawLabel isString ifTrue:[
       
  4949 "/        rawLabel isText ifFalse:[
       
  4950 "/            rawLabel := rawLabel withoutSeparators
       
  4951 "/        ].        
       
  4952 "/
       
  4953         form isNil ifTrue:[                             "/ check for separator
       
  4954             rawLabel isEmpty ifTrue:[
       
  4955                   rawLabel := nil.                      "/ indication for separator
       
  4956                 ^ self
       
  4957             ].
  4967             ].
  4958 
  4968             rslt
  4959             rawLabel size == 1 ifTrue:[
  4969         ].
  4960                 char := rawLabel first.
  4970 
  4961 
  4971         rawLabel isArray ifTrue:[
  4962                 (char == $- or:[char == $=]) ifTrue:[   "/ other line separators
  4972             rawLabel keysAndValuesDo:[:anIndex :aLabel|
  4963                     label    := rawLabel.
  4973                 rawLabel at:anIndex put:(block value:aLabel)
  4964                     rawLabel := nil.                    "/ indication for separator
       
  4965                   ^ self
       
  4966                 ]
       
  4967             ]
  4974             ]
  4968         ].
  4975         ] ifFalse:[
  4969 "/        rawLabel isEmpty ifTrue:[
  4976             rawLabel := block value:rawLabel
  4970 "/            rawLabel := label value
       
  4971 "/        ].
       
  4972         size := self accessCharacterPosition.
       
  4973 
       
  4974         (size notNil and:[size <= rawLabel size]) ifTrue:[
       
  4975             rawLabel isText ifFalse:[
       
  4976                 rawLabel := Text string:rawLabel
       
  4977             ].
       
  4978             rawLabel emphasisAt:size add:#underline
       
  4979         ]
  4977         ]
  4980     ].
  4978     ].
  4981     rawLabel isImage ifTrue:[
  4979 !
  4982         rawImage := rawLabel.
  4980 
  4983 
  4981 updateAccessCharacterFor:aLabel
  4984         form notNil ifTrue:[
  4982     |s i rest label pos|
  4985             isButton ifTrue:[form := nil].
  4983 
  4986             rawLabel := LabelAndIcon form:form image:rawImage.
  4984     (accessCharacter notNil or:[aLabel isNil]) ifTrue:[
  4987         ]
  4985         ^ aLabel
  4988     ] ifFalse:[
  4986     ].
  4989         rawLabel class == LabelAndIcon ifTrue:[
  4987 
  4990             rawImage := rawLabel icon.
  4988     aLabel isString ifFalse:[
  4991 
  4989         aLabel class == LabelAndIcon ifTrue:[
  4992             (form notNil and:[isButton not]) ifTrue:[
  4990             aLabel string:(self updateAccessCharacterFor:(aLabel string))
  4993                 rawLabel image:rawImage.
  4991         ].
  4994                 rawLabel icon:form
  4992         ^ aLabel
  4995             ]                
  4993     ].
  4996         ] ifFalse:[
  4994 
  4997             rawImage := nil.
  4995     s := aLabel size.
  4998             rawLabel isNil ifTrue:[rawLabel := ''].
  4996     i := 1.
  4999 
  4997 
  5000             (form notNil and:[isButton not]) ifTrue:[
  4998     label := aLabel.
  5001                 rawLabel := LabelAndIcon icon:form string:rawLabel.
  4999     pos := accessCharacterPosition.
  5002             ] ifFalse:[
  5000 
  5003                 disabledRawLabel := rawLabel.
  5001     [((i := label indexOf:$& startingAt:i) ~~ 0 and:[i < s])] whileTrue:[
  5004             ]
  5002         rest := label copyFrom:(i+1).
  5005         ].
  5003 
  5006     ].
  5004         i == 1 ifTrue:[label := rest]
  5007     menuPanel shown ifTrue:[ self fetchImages ].
  5005               ifFalse:[label := (label copyFrom:1 to:(i-1)), rest].
  5008     menuPanel mustRearrange
  5006 
       
  5007         (label at:i) == $& ifTrue:[i := i + 1] ifFalse:[pos := i].
       
  5008         s := s - 1.
       
  5009     ].
       
  5010 
       
  5011     (pos isNil or:[(accessCharacter := label at:pos ifAbsent:nil) isNil]) ifTrue:[
       
  5012         ^ aLabel
       
  5013     ].
       
  5014 
       
  5015     label isText ifFalse:[
       
  5016         label := Text string:label
       
  5017     ].
       
  5018     label emphasisAt:pos add:#underline.
       
  5019   ^ label
       
  5020 
  5009 ! !
  5021 ! !
  5010 
  5022 
  5011 !MenuPanel::Item methodsFor:'printing & storing'!
  5023 !MenuPanel::Item methodsFor:'printing & storing'!
  5012 
  5024 
  5013 displayString
  5025 displayString
  5028 activeForegroundColor
  5040 activeForegroundColor
  5029     "returns the active foreground color derived from menuPanel
  5041     "returns the active foreground color derived from menuPanel
  5030     "
  5042     "
  5031 
  5043 
  5032     ^menuPanel activeForegroundColor
  5044     ^menuPanel activeForegroundColor
  5033 !
       
  5034 
       
  5035 adornment
       
  5036     "returns adornment; if not existing yet a new instance
       
  5037      is created
       
  5038     "
       
  5039     adornment isNil ifTrue:[
       
  5040 	adornment := Adornment new
       
  5041     ].
       
  5042   ^ adornment
       
  5043 !
  5045 !
  5044 
  5046 
  5045 backgroundColor
  5047 backgroundColor
  5046     "returns the background color derived from menuPanel
  5048     "returns the background color derived from menuPanel
  5047     "
  5049     "
  5087 !
  5089 !
  5088 
  5090 
  5089 choiceForm
  5091 choiceForm
  5090     "returns choice form or nil
  5092     "returns choice form or nil
  5091     "
  5093     "
  5092     |holder|
  5094     choice isNil ifTrue:[^ nil].
  5093 
  5095 
  5094     (holder := self choice) isNil ifTrue:[^ nil].
  5096     ^ choice value = choiceValue ifTrue:[menuPanel iconRadioGroupOn]
  5095 
  5097                                 ifFalse:[menuPanel iconRadioGroupOff]
  5096     holder value = self choiceValue ifTrue:[
       
  5097 	^ self class checkOnIcon
       
  5098     ].
       
  5099     ^ self class checkOffIcon
       
  5100 !
  5098 !
  5101 
  5099 
  5102 findSubMenuIn:aRecv
  5100 findSubMenuIn:aRecv
  5103     "ask the receiver for a submenu aspect, sending it
  5101     "ask the receiver for a submenu aspect, sending it
  5104      #aspectFor: first; then trying the selector itself.
  5102      #aspectFor: first; then trying the selector itself.
  5105      Ignore the error if that message is not understood
  5103      Ignore the error if that message is not understood
  5106      (but not other message-not-understoods)"
  5104      (but not other message-not-understoods)"
  5107 
  5105 
  5108     |subm argument sel|
  5106     |subm sel|
  5109 
  5107 
  5110     subm := nil.
  5108     subm := nil.
  5111 
  5109 
  5112     aRecv notNil ifTrue:[
  5110     aRecv notNil ifTrue:[
  5113         submenuChannel last ~~ $: ifTrue:[
  5111         submenuChannel last ~~ $: ifTrue:[
  5143                         submenuChannel := nil.
  5141                         submenuChannel := nil.
  5144                     ]
  5142                     ]
  5145                 ]
  5143                 ]
  5146             ]
  5144             ]
  5147         ] ifFalse:[
  5145         ] ifFalse:[
  5148             (argument := self argument) notNil ifTrue:[
  5146             argument notNil ifTrue:[
  5149                 sel := submenuChannel asSymbol.
  5147                 sel := submenuChannel asSymbol.
  5150                 Object messageNotUnderstoodSignal handle:[:ex| 
  5148                 Object messageNotUnderstoodSignal handle:[:ex| 
  5151                     ex parameter selector == sel ifFalse:[
  5149                     ex parameter selector == sel ifFalse:[
  5152                         ex reject
  5150                         ex reject
  5153                     ].
  5151                     ].
  5178 !
  5176 !
  5179 
  5177 
  5180 indicationValue
  5178 indicationValue
  5181     "returns indication value or nil in case of no indication
  5179     "returns indication value or nil in case of no indication
  5182     "
  5180     "
  5183     |indication numArgs sel recv|
  5181     |numArgs sel recv|
  5184 
  5182 
  5185     (indication := self indication) isNil ifTrue:[
  5183     indication isNil ifTrue:[^ nil].                                    "no indication specified"
  5186         ^ nil                                           "/ has no indication
  5184 
  5187     ].
  5185     indication isSymbol ifFalse:[                                       
  5188 
  5186         ^ indication value == true                                      "block or model"
  5189     indication isSymbol ifTrue:[
  5187     ].
  5190         (numArgs := indication numArgs) ~~ 0 ifTrue:[
  5188 
  5191             numArgs == 2 ifTrue:[
  5189     (numArgs := indication numArgs) == 2 ifTrue:[
  5192                 recv := menuPanel receiver.
  5190         recv := menuPanel receiver.
  5193 
  5191 
  5194                 (recv isValueModel) ifFalse:[
  5192         (recv isValueModel) ifFalse:[
  5195                     (recv notNil or:[(recv := menuPanel application) notNil]) ifTrue:[
  5193             (recv notNil or:[(recv := menuPanel application) notNil]) ifTrue:[
  5196                         sel := indication copyFrom:1 to:(indication indexOf:$:).
  5194                 sel := indication copyFrom:1 to:(indication indexOf:$:).
  5197                         indication := nil.
  5195                 sel := sel asSymbol.
  5198                         sel := sel asSymbol.
  5196 
  5199 
  5197                 Object messageNotUnderstoodSignal handle:[:ex| 
  5200                         Object messageNotUnderstoodSignal handle:[:ex| 
  5198                     ex parameter selector == sel ifFalse:[
  5201                             ex parameter selector == sel ifFalse:[
  5199                         ex reject
  5202                                 ex reject
       
  5203                             ].
       
  5204                         ] do:[
       
  5205                             indication := recv perform:sel with:self argument
       
  5206                         ]
       
  5207                     ].
  5200                     ].
  5208                 ].
  5201                 ] do:[
  5209                 ^ indication value == true
  5202                     sel := recv perform:sel with:argument
       
  5203                 ]
  5210             ].
  5204             ].
  5211             indication := (indication copyWithoutLast:1) asSymbol
  5205         ].
  5212         ].
  5206         ^ sel value == true
  5213         indication := self aspectAt:indication.
  5207     ].
  5214 
  5208 
  5215         indication isValueModel ifTrue:[
  5209     numArgs ~~ 0 ifTrue:[
  5216             self adornment indication:indication.
  5210         sel := (indication copyWithoutLast:1) asSymbol
  5217             indication addDependent:self.
  5211     ] ifFalse:[
  5218         ]
  5212         sel := indication
  5219     ].
  5213     ].    
  5220     ^ indication value == true
  5214     sel := self aspectAt:sel.
  5221 
  5215 
  5222     "Modified: / 8.8.1998 / 02:15:15 / cg"
  5216     sel isValueModel ifTrue:[
       
  5217         indication := sel.
       
  5218         indication addDependent:self.
       
  5219     ].
       
  5220     ^ sel value == true
  5223 !
  5221 !
  5224 
  5222 
  5225 indicationValue:aValue
  5223 indicationValue:aValue
  5226     "set the indication value
  5224     "set the indication value
  5227     "
  5225     "
  5228     |numArgs indication recv|
  5226     |numArgs recv|
  5229 
  5227 
  5230     (indication := self indication) isNil ifTrue:[
  5228     indication isNil ifTrue:[^ self].                                   "no indication specified"
  5231 	^ self                                          "/ has no indication
  5229 
  5232     ].
  5230     indication isSymbol ifFalse:[                                       
  5233 
  5231         indication perform:#value: with:aValue ifNotUnderstood:nil.     "block or model"
  5234     indication isSymbol ifFalse:[
  5232       ^ self
  5235 	(indication respondsTo:#value:) ifTrue:[        "/ valueHolder or block
  5233     ].
  5236 	    indication value:aValue
  5234 
  5237 	].
  5235     (numArgs := indication numArgs) == 0 ifTrue:[                       "no arguments to selector; cannot set"
  5238 	^ self
  5236         ^ self
  5239     ].
  5237     ].
  5240 
  5238 
  5241     recv := menuPanel receiver.
  5239     recv := menuPanel receiver.
       
  5240     recv isValueModel ifTrue:[^ self].
       
  5241 
  5242     recv isNil ifTrue:[
  5242     recv isNil ifTrue:[
  5243 	recv := menuPanel application.
  5243         recv := menuPanel application.
  5244 	recv isNil ifTrue:[^ self].
  5244         recv isNil ifTrue:[^ self].
  5245     ].
  5245     ].
  5246 
  5246 
  5247     (numArgs := indication numArgs) ~~ 0 ifTrue:[
  5247     Object messageNotUnderstoodSignal handle:[:ex| 
  5248 	Object messageNotUnderstoodSignal handle:[:ex| 
  5248         (ex parameter selector ~~ indication) ifTrue:[
  5249 	    (ex parameter selector ~~ indication) ifTrue:[
  5249             ex reject
  5250 		ex reject
  5250         ]
  5251 	    ]
  5251     ] do:[
  5252 	] do:[
  5252         numArgs == 1 ifTrue:[
  5253 	    numArgs == 1 ifTrue:[
  5253             recv perform:indication with:aValue
  5254 		recv perform:indication with:aValue
  5254         ] ifFalse:[
  5255 	    ] ifFalse:[
  5255             recv perform:indication with:(argument ? self) with:aValue
  5256 		recv perform:indication with:(self argument ? self) with:aValue
  5256         ]
  5257 	    ]
  5257     ].
  5258 	]
       
  5259     ].
       
  5260 
       
  5261     "Modified: / 28.7.1998 / 20:47:08 / cg"
       
  5262 !
  5258 !
  5263 
  5259 
  5264 indicatorForm
  5260 indicatorForm
  5265     "returns indication form or nil
  5261     "returns indication form or nil
  5266     "
  5262     "
  5267     |value|
  5263     indication isNil ifTrue:[^ nil].
  5268 
  5264 
  5269     (value := self indicationValue) isNil ifTrue:[
  5265   ^ self indicationValue == true ifTrue:[menuPanel iconIndicationOn]
  5270 	^ nil
  5266                                 ifFalse:[menuPanel iconIndicationOff]
  5271     ].
       
  5272   ^ value ifTrue:[IndicatorOn] ifFalse:[IndicatorOff]
       
  5273 
       
  5274     "Created: / 14.8.1998 / 15:53:53 / cg"
       
  5275 !
  5267 !
  5276 
  5268 
  5277 isEntered
  5269 isEntered
  5278     "returns true if the mouse pointer is over the item
  5270     "returns true if the mouse pointer is over the item
  5279     "
  5271     "
  5358 
  5350 
  5359 canSelect
  5351 canSelect
  5360     "returns true if item is selectable; no separator, visible and enabled.
  5352     "returns true if item is selectable; no separator, visible and enabled.
  5361      in case of a choice (RadioButton) i have to check for the choiceValue
  5353      in case of a choice (RadioButton) i have to check for the choiceValue
  5362     "
  5354     "
  5363     |holder|
       
  5364 
       
  5365     (rawLabel notNil and:[self isVisible and:[self enabled]]) ifTrue:[
  5355     (rawLabel notNil and:[self isVisible and:[self enabled]]) ifTrue:[
  5366         ((holder := self choice) isNil or:[holder value ~= self choiceValue]) ifTrue:[
  5356         (choice isNil or:[choice value ~= choiceValue]) ifTrue:[
  5367             ^ true
  5357             ^ true
  5368         ].
  5358         ].
  5369     ].
  5359     ].
  5370     ^ false
  5360     ^ false
  5371 !
  5361 !
  5380 !
  5370 !
  5381 
  5371 
  5382 hasIndication
  5372 hasIndication
  5383     "returns true if on/off indication exists
  5373     "returns true if on/off indication exists
  5384     "
  5374     "
  5385   ^ self indication notNil
  5375     ^ indication notNil
  5386 !
  5376 !
  5387 
  5377 
  5388 hasSubmenu
  5378 hasSubmenu
  5389     "returns true if the item is configured as an subMenu entry
  5379     "returns true if the item is configured as an subMenu entry
  5390     "
  5380     "
  5528 
  5518 
  5529 selected:isSelected
  5519 selected:isSelected
  5530     "change selection to a state. Dependant on the state open or hide an existing
  5520     "change selection to a state. Dependant on the state open or hide an existing
  5531      submenu and perform a redraw
  5521      submenu and perform a redraw
  5532     "
  5522     "
       
  5523     menuPanel isNil ifTrue:[
       
  5524         ^ self hideSubmenu
       
  5525     ].
       
  5526 
  5533     isSelected ifFalse:[
  5527     isSelected ifFalse:[
       
  5528         self invalidate.
  5534         self hideSubmenu.
  5529         self hideSubmenu.
  5535         menuPanel invalidateItem:self repairNow:true.
       
  5536     ] ifTrue:[
  5530     ] ifTrue:[
  5537         menuPanel realized ifTrue:[
  5531         menuPanel realized ifTrue:[
  5538             (self indication isNil or:[isButton not]) ifTrue:[
  5532             (indication isNil or:[isButton not]) ifTrue:[
  5539                 menuPanel invalidateItem:self repairNow:true.
  5533                 self invalidate
  5540             ].
  5534             ].
  5541 
  5535 
  5542             (subMenu := self setupSubmenu) notNil ifTrue:[
  5536             (subMenu := self setupSubmenu) notNil ifTrue:[
  5543                 self openSubmenu
  5537                 self openSubmenu
  5544             ]
  5538             ]
  5545         ]
  5539         ]
  5546     ].
  5540     ].
  5547 ! !
  5541 ! !
  5548 
  5542 
  5549 !MenuPanel::Item::Adornment methodsFor:'accessing'!
       
  5550 
       
  5551 accessCharacterPosition
       
  5552     "get the index of the access character in the label text or string, or nil if none
       
  5553     "
       
  5554     ^ accessCharacterPosition
       
  5555 !
       
  5556 
       
  5557 accessCharacterPosition:anIndexOrNil
       
  5558     "set the index of the access character in the label text or string, or nil if none
       
  5559     "
       
  5560     accessCharacterPosition := anIndexOrNil
       
  5561 !
       
  5562 
       
  5563 argument
       
  5564     "ST/X goody; get argunment to a selector or block
       
  5565     "
       
  5566   ^ argument
       
  5567 !
       
  5568 
       
  5569 argument:anArgumentOrNil
       
  5570     "ST/X goody; set argunment to a selector or block
       
  5571     "
       
  5572     argument := anArgumentOrNil
       
  5573 !
       
  5574 
       
  5575 choice
       
  5576     "get has choice indicator value
       
  5577     "
       
  5578   ^ choice
       
  5579 
       
  5580     "Created: / 14.8.1998 / 14:41:31 / cg"
       
  5581 !
       
  5582 
       
  5583 choice:something
       
  5584     "set choice indicator value
       
  5585     "
       
  5586     choice := something.
       
  5587 
       
  5588     "Created: / 14.8.1998 / 14:41:39 / cg"
       
  5589 !
       
  5590 
       
  5591 choiceValue
       
  5592     "return the value of the instance variable 'choiceValue' (automatically generated)"
       
  5593 
       
  5594     ^ choiceValue
       
  5595 
       
  5596     "Created: / 14.8.1998 / 15:47:52 / cg"
       
  5597 !
       
  5598 
       
  5599 choiceValue:something
       
  5600     "set the value of the instance variable 'choiceValue' (automatically generated)"
       
  5601 
       
  5602     choiceValue := something.
       
  5603 
       
  5604     "Created: / 14.8.1998 / 15:47:52 / cg"
       
  5605 !
       
  5606 
       
  5607 indication
       
  5608     "get has on/off indicator value
       
  5609     "
       
  5610   ^ indication
       
  5611 !
       
  5612 
       
  5613 indication:something
       
  5614     "set has on/off indicator value
       
  5615     "
       
  5616     indication := something.
       
  5617 !
       
  5618 
       
  5619 shortcutKey
       
  5620     "get the character that is used as a shortcut key for this item
       
  5621     "
       
  5622   ^ shortcutKey
       
  5623 !
       
  5624 
       
  5625 shortcutKey:aKeyOrNil
       
  5626     "set the character that is used as a shortcut key for this item
       
  5627     "
       
  5628     shortcutKey := aKeyOrNil
       
  5629 !
       
  5630 
       
  5631 showBusyCursorWhilePerforming
       
  5632     "get the flag which controls if a busy cursor is to be shown
       
  5633      while performing the menu action. Defaults to false."
       
  5634 
       
  5635     ^ showBusyCursorWhilePerforming ? false
       
  5636 
       
  5637 
       
  5638 !
       
  5639 
       
  5640 showBusyCursorWhilePerforming:aBoolean
       
  5641     "set/clear the flag which controls if a busy cursor is to be shown
       
  5642      while performing the menu action. Defaults to false."
       
  5643 
       
  5644     showBusyCursorWhilePerforming := aBoolean
       
  5645 
       
  5646 
       
  5647 ! !
       
  5648 
       
  5649 !MenuPanel class methodsFor:'documentation'!
  5543 !MenuPanel class methodsFor:'documentation'!
  5650 
  5544 
  5651 version
  5545 version
  5652     ^ '$Header: /cvs/stx/stx/libwidg2/MenuPanel.st,v 1.209 2000-02-24 07:47:47 ca Exp $'
  5546     ^ '$Header: /cvs/stx/stx/libwidg2/MenuPanel.st,v 1.210 2000-02-25 16:58:56 ca Exp $'
  5653 ! !
  5547 ! !
  5654 MenuPanel initialize!
  5548 MenuPanel initialize!