hg/stx-libwidg2: MenuPanel.st@ea2a32738005 (annotated)

2005 a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	1	"
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	2	COPYRIGHT (c) 1997 by eXept Software AG
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	3	All Rights Reserved
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	4
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	5	This software is furnished under a license and may be used
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	6	only in accordance with the terms of that license and with the
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	7	inclusion of the above copyright notice. This software may not
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	8	be provided or otherwise made available to, or used by, any
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	9	other person. No title to or ownership of the software is
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	10	hereby transferred.
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	11	"
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	12
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	13
1750 f9e5700bd99a compatibility stuff Claus Gittinger <cg@exept.de> parents: 1737 diff changeset	14	"{ Package: 'stx:libwidg2' }"
f9e5700bd99a compatibility stuff Claus Gittinger <cg@exept.de> parents: 1737 diff changeset	15
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	16	SimpleView subclass:#MenuPanel
689 aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	17	instanceVariableNames:'adornment shadowView mapTime mustRearrange superMenu
aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	18	shortKeyInset selection items groupSizes receiver enableChannel
aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	19	menuHolder enabled onLevel offLevel fgColor activeFgColor
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	20	lastActiveMenu activeBgColor disabledFgColor
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	21	disabledEtchedFgColor groupDividerSize itemSpace fitFirstPanel
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	22	rightArrow rightArrowShadow selectionFrameBrightColor
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	23	selectionFrameDarkColor buttonLightColor buttonShadowColor
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	24	buttonHalfLightColor buttonHalfShadowColor enteredItem
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	25	buttonEnteredBgColor prevFocusView previousPointerGrab
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	26	previousKeyboardGrab relativeGrabOrigin hasImplicitGrap
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	27	iconIndicationOff iconIndicationOn iconRadioGroupOff
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	28	iconRadioGroupOn iconIndicationDisabledOff
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	29	iconIndicationDisabledOn iconRadioGroupDisabledOff
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	30	iconRadioGroupDisabledOn scrollActivity stillPressedAction'
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	31	classVariableNames:'InitialSelectionQuerySignal DefaultAdornment ShortcutKeyOffset
689 aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	32	DefaultGroupDividerSize DefaultHilightLevel DefaultLevel
1082 382324ddce3f support and additional buttonSpacing (for normal and win95 styles) Claus Gittinger <cg@exept.de> parents: 1081 diff changeset	33	DefaultItemSpace DefaultButtonItemSpace DefaultForegroundColor
382324ddce3f support and additional buttonSpacing (for normal and win95 styles) Claus Gittinger <cg@exept.de> parents: 1081 diff changeset	34	DefaultBackgroundColor DefaultHilightForegroundColor
382324ddce3f support and additional buttonSpacing (for normal and win95 styles) Claus Gittinger <cg@exept.de> parents: 1081 diff changeset	35	DefaultHilightBackgroundColor DefaultDisabledForegroundColor
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	36	DefaultDisabledEtchedForegroundColor DefaultEnteredLevel
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	37	DefaultSelectionFollowsMouse DefaultOpenOnSelect
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	38	DefaultFitFirstPanel RightArrowForm RightArrowShadowForm
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	39	SelectionFrameBrightColor SelectionFrameDarkColor
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	40	ButtonActiveLevel ButtonPassiveLevel ButtonActiveBackgroundColor
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	41	ButtonPassiveBackgroundColor ButtonLightColor ButtonShadowColor
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	42	ButtonHalfLightColor ButtonHalfShadowColor ButtonEdgeStyle Images
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	43	LigthenedImages ButtonEnteredBackgroundColor ButtonEnteredLevel'
689 aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	44	poolDictionaries:''
aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	45	category:'Views-Menus'
388 dce33f8bb806 intitial checkin ca parents: diff changeset	46	!
dce33f8bb806 intitial checkin ca parents: diff changeset	47
dce33f8bb806 intitial checkin ca parents: diff changeset	48	Object subclass:#Item
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	49	instanceVariableNames:'layout menuPanel subMenu rawLabel rawLabelExtent disabledRawLabel
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	50	enableChannel nameKey value label activeHelpKey activeHelpText
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	51	submenuChannel startGroup isButton isVisible hideMenuOnActivated
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	52	indication accessCharacterPosition shortcutKey argument choice
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	53	choiceValue showBusyCursorWhilePerforming accessCharacter font
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	54	keepLinkedMenu triggerOnDown horizontalLayout delayMenu'
689 aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	55	classVariableNames:'HorizontalInset VerticalInset HorizontalButtonInset
1765 a003f417d6ad fix for vertical spacing Claus Gittinger <cg@exept.de> parents: 1762 diff changeset	56	VerticalButtonInset LabelRightOffset VerticalPopUpInset'
689 aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	57	poolDictionaries:''
aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	58	privateIn:MenuPanel
388 dce33f8bb806 intitial checkin ca parents: diff changeset	59	!
dce33f8bb806 intitial checkin ca parents: diff changeset	60
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	61	Object subclass:#ScrollActivity
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	62	instanceVariableNames:'semaLock activeMenu scrollTask direction icons'
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	63	classVariableNames:''
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	64	poolDictionaries:''
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	65	privateIn:MenuPanel
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	66	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	67
388 dce33f8bb806 intitial checkin ca parents: diff changeset	68	!MenuPanel class methodsFor:'documentation'!
dce33f8bb806 intitial checkin ca parents: diff changeset	69
2005 a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	70	copyright
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	71	"
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	72	COPYRIGHT (c) 1997 by eXept Software AG
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	73	All Rights Reserved
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	74
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	75	This software is furnished under a license and may be used
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	76	only in accordance with the terms of that license and with the
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	77	inclusion of the above copyright notice. This software may not
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	78	be provided or otherwise made available to, or used by, any
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	79	other person. No title to or ownership of the software is
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	80	hereby transferred.
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	81	"
a85fab2cc6f6 * empty log message * Claus Gittinger <cg@exept.de> parents: 2004 diff changeset	82
388 dce33f8bb806 intitial checkin ca parents: diff changeset	83	!
dce33f8bb806 intitial checkin ca parents: diff changeset	84
dce33f8bb806 intitial checkin ca parents: diff changeset	85	documentation
dce33f8bb806 intitial checkin ca parents: diff changeset	86	"
dce33f8bb806 intitial checkin ca parents: diff changeset	87	a menu panel used for both pull-down-menus and pop-up-menus.
dce33f8bb806 intitial checkin ca parents: diff changeset	88
dce33f8bb806 intitial checkin ca parents: diff changeset	89	not yet finished MenuPanel class - this will eventually replace
dce33f8bb806 intitial checkin ca parents: diff changeset	90	most of the MenuView and PopUpMenu stuff.
dce33f8bb806 intitial checkin ca parents: diff changeset	91	(and hopefully be ST-80 compatible ...)
dce33f8bb806 intitial checkin ca parents: diff changeset	92
502 dedc1b29b6ac support of arguments ca parents: 498 diff changeset	93	To create a menu, there exists a MenuEditor which will generate
dedc1b29b6ac support of arguments ca parents: 498 diff changeset	94	a menu specification.
dedc1b29b6ac support of arguments ca parents: 498 diff changeset	95
dedc1b29b6ac support of arguments ca parents: 498 diff changeset	96
2061 faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	97	Notice:
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	98	This is going to replace the obsolete MenuView.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	99
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	100	DefaultSelectionFollowsMouse := true.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	101	DefaultSelectionFollowsMouse := false.
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	102
388 dce33f8bb806 intitial checkin ca parents: diff changeset	103	[author:]
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	104	Claus Atzkern
388 dce33f8bb806 intitial checkin ca parents: diff changeset	105
dce33f8bb806 intitial checkin ca parents: diff changeset	106	[see also:]
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	107	Menu
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	108	MenuItem
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	109	MenuEditor
388 dce33f8bb806 intitial checkin ca parents: diff changeset	110	"
dce33f8bb806 intitial checkin ca parents: diff changeset	111	!
dce33f8bb806 intitial checkin ca parents: diff changeset	112
dce33f8bb806 intitial checkin ca parents: diff changeset	113	examples
dce33f8bb806 intitial checkin ca parents: diff changeset	114
dce33f8bb806 intitial checkin ca parents: diff changeset	115	"
dce33f8bb806 intitial checkin ca parents: diff changeset	116	start as PullDownMenu
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	117	[exBegin]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	118	\|top subView mview desc s1 s2 s3 img lbs labels\|
dce33f8bb806 intitial checkin ca parents: diff changeset	119
dce33f8bb806 intitial checkin ca parents: diff changeset	120	top := StandardSystemView new.
dce33f8bb806 intitial checkin ca parents: diff changeset	121
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	122	mview := MenuPanel in:top.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	123
502 dedc1b29b6ac support of arguments ca parents: 498 diff changeset	124	labels := #( 'foo' 'bar' 'baz' 'test' 'claus' ).
388 dce33f8bb806 intitial checkin ca parents: diff changeset	125	mview level:2.
dce33f8bb806 intitial checkin ca parents: diff changeset	126	mview verticalLayout:false.
dce33f8bb806 intitial checkin ca parents: diff changeset	127	img := Image fromFile:'bitmaps/SBrowser.xbm'.
502 dedc1b29b6ac support of arguments ca parents: 498 diff changeset	128	lbs := Array with:'foo' with:'bar' with:img with:'baz' with:'test' with:'ludwig'.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	129	mview labels:lbs.
dce33f8bb806 intitial checkin ca parents: diff changeset	130	mview shortcutKeyAt:2 put:#Cut.
dce33f8bb806 intitial checkin ca parents: diff changeset	131	mview accessCharacterPositionAt:1 put:1.
dce33f8bb806 intitial checkin ca parents: diff changeset	132	mview accessCharacterPositionAt:2 put:2.
dce33f8bb806 intitial checkin ca parents: diff changeset	133
dce33f8bb806 intitial checkin ca parents: diff changeset	134	mview enabledAt:5 put:false.
dce33f8bb806 intitial checkin ca parents: diff changeset	135	mview groupSizes:#( 2 2 ).
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	136	s1 := MenuPanel labels:labels.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	137	s1 accessCharacterPositionAt:1 put:1.
dce33f8bb806 intitial checkin ca parents: diff changeset	138	s1 accessCharacterPositionAt:2 put:2.
dce33f8bb806 intitial checkin ca parents: diff changeset	139	s1 groupSizes:#( 2 2 ).
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	140	s2 := MenuPanel labels:#( '1' nil '2' '-' '3' '=' '4' ' ' '5' ).
c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	141	s3 := MenuPanel labels:lbs.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	142
dce33f8bb806 intitial checkin ca parents: diff changeset	143	s1 subMenuAt:2 put:s2.
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	144	s1 subMenuAt:3 put:(MenuPanel labels:lbs).
388 dce33f8bb806 intitial checkin ca parents: diff changeset	145	s2 subMenuAt:3 put:s3.
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	146	s3 subMenuAt:3 put:(MenuPanel labels:labels).
388 dce33f8bb806 intitial checkin ca parents: diff changeset	147	s3 shortcutKeyAt:3 put:$q.
dce33f8bb806 intitial checkin ca parents: diff changeset	148
dce33f8bb806 intitial checkin ca parents: diff changeset	149	mview subMenuAt:1 put:s1.
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	150	mview subMenuAt:4 put:(MenuPanel labels:lbs).
388 dce33f8bb806 intitial checkin ca parents: diff changeset	151	(mview subMenuAt:4) shortcutKeyAt:3 put:#Copy.
dce33f8bb806 intitial checkin ca parents: diff changeset	152	s1 shortcutKeyAt:1 put:#Copy.
dce33f8bb806 intitial checkin ca parents: diff changeset	153	s1 shortcutKeyAt:3 put:#Paste.
dce33f8bb806 intitial checkin ca parents: diff changeset	154
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	155	mview subMenuAt:2 put:(MenuPanel labels:labels).
616 a6157b083830 support of different styles ca parents: 608 diff changeset	156	top extent:(mview preferredExtent).
388 dce33f8bb806 intitial checkin ca parents: diff changeset	157	top open.
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	158	[exEnd]
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	159
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	160	[exBegin]
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	161	\|top menu view item\|
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	162
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	163	top := StandardSystemView extent:240@100.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	164	menu := MenuPanel in:top.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	165	menu labels:#( 'foo' 'Application' 'Clock' ).
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	166	menu verticalLayout:false.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	167
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	168	menu subMenuAt:1 put:(MenuPanel labels:#( 'bar' 'baz' )).
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	169	menu subMenuAt:2 put:(MenuPanel labels:#( 'foo' 'bar' 'baz' )).
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	170
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	171	view := ClockView new.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	172	view preferredExtent:100@100.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	173	item := menu itemAt:3.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	174	item submenu:view.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	175
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	176	view := SimpleView new.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	177	view client:(CodingExamples_GUI::GUIDemoExtendedComboBox new).
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	178	view preferredExtent:(400@50).
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	179	item := menu itemAt:2.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	180	item submenu:view.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	181
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	182	menu origin:0@0 corner:1.0@30.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	183	top open.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	184	[exEnd]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	185
dce33f8bb806 intitial checkin ca parents: diff changeset	186
dce33f8bb806 intitial checkin ca parents: diff changeset	187	start as PopUpMenu
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	188	[exBegin]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	189	\|subView mview desc s1 s2 s3 img lbs labels\|
dce33f8bb806 intitial checkin ca parents: diff changeset	190
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	191	mview := MenuPanel new.
502 dedc1b29b6ac support of arguments ca parents: 498 diff changeset	192	labels := #( 'foo' 'bar' 'baz' ).
388 dce33f8bb806 intitial checkin ca parents: diff changeset	193	mview level:2.
dce33f8bb806 intitial checkin ca parents: diff changeset	194
dce33f8bb806 intitial checkin ca parents: diff changeset	195	img := Image fromFile:'bitmaps/SBrowser.xbm'.
502 dedc1b29b6ac support of arguments ca parents: 498 diff changeset	196	lbs := Array with:'foo' with:'bar' with:img with:'baz' with:'test'.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	197	mview labels:lbs.
dce33f8bb806 intitial checkin ca parents: diff changeset	198
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	199	s1 := MenuPanel labels:labels.
c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	200	s2 := MenuPanel labels:#( '1' nil '2' '-' '3' '=' '4' ' ' '5' ).
c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	201	s3 := MenuPanel labels:lbs.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	202	s1 subMenuAt:2 put:s2.
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	203	s1 subMenuAt:3 put:(MenuPanel labels:lbs).
388 dce33f8bb806 intitial checkin ca parents: diff changeset	204	s2 subMenuAt:3 put:s3.
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	205	s3 subMenuAt:3 put:(MenuPanel labels:labels).
388 dce33f8bb806 intitial checkin ca parents: diff changeset	206	s3 shortcutKeyAt:3 put:$q.
dce33f8bb806 intitial checkin ca parents: diff changeset	207
dce33f8bb806 intitial checkin ca parents: diff changeset	208	mview subMenuAt:1 put:s1.
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	209	mview subMenuAt:4 put:(MenuPanel labels:lbs).
388 dce33f8bb806 intitial checkin ca parents: diff changeset	210	(mview subMenuAt:4) shortcutKeyAt:3 put:#Copy.
dce33f8bb806 intitial checkin ca parents: diff changeset	211	s1 shortcutKeyAt:1 put:#Copy.
dce33f8bb806 intitial checkin ca parents: diff changeset	212	s1 shortcutKeyAt:3 put:#Paste.
dce33f8bb806 intitial checkin ca parents: diff changeset	213
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	214	mview subMenuAt:2 put:(MenuPanel labels:labels).
388 dce33f8bb806 intitial checkin ca parents: diff changeset	215	mview startUp
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	216	[exEnd]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	217
dce33f8bb806 intitial checkin ca parents: diff changeset	218
dce33f8bb806 intitial checkin ca parents: diff changeset	219	start from menu spec
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	220	[exBegin]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	221	\|menu\|
dce33f8bb806 intitial checkin ca parents: diff changeset	222
436 c03d6faa41a6 process events befor accept ca parents: 434 diff changeset	223	menu := MenuPanel menu:
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	224	#(#Menu #( #(#MenuItem
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	225	#label: 'File'
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	226	#submenu:
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	227	#(#Menu #(#(#MenuItem #label: 'quit' #value:#quit )
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	228	(#MenuItem
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	229	#label: 'edit'
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	230	#submenu:
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	231	#(#Menu #( #(#MenuItem #label: 'edit' #value:#edit )
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	232	#(#MenuItem #label: 'close' #value:#close)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	233	)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	234	nil
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	235	nil
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	236	)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	237	)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	238	#(#MenuItem #label: 'help' #value:#help )
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	239	)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	240	nil
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	241	nil
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	242	)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	243	)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	244	#(#MenuItem #label: 'Inspect' #value:#inspectMenu )
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	245	#(#MenuItem #label: 'Bar'
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	246	#submenu:
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	247	#(#Menu #( #(#MenuItem #label: 'bar 1' #value:#bar1 )
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	248	#(#MenuItem #label: 'bar 2' #value:#bar2 )
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	249	)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	250	nil
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	251	nil
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	252	)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	253	)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	254	)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	255	#( 2 )
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	256	nil
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	257	) decodeAsLiteralArray.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	258
dce33f8bb806 intitial checkin ca parents: diff changeset	259	menu verticalLayout:false.
dce33f8bb806 intitial checkin ca parents: diff changeset	260	Transcript showCR:(menu startUp).
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	261	[exEnd]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	262
dce33f8bb806 intitial checkin ca parents: diff changeset	263	"
dce33f8bb806 intitial checkin ca parents: diff changeset	264
dce33f8bb806 intitial checkin ca parents: diff changeset	265	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	266
dce33f8bb806 intitial checkin ca parents: diff changeset	267	!MenuPanel class methodsFor:'instance creation'!
dce33f8bb806 intitial checkin ca parents: diff changeset	268
dce33f8bb806 intitial checkin ca parents: diff changeset	269	fromSpec:aSpec
dce33f8bb806 intitial checkin ca parents: diff changeset	270	^ self fromSpec:aSpec receiver:nil
dce33f8bb806 intitial checkin ca parents: diff changeset	271	!
dce33f8bb806 intitial checkin ca parents: diff changeset	272
dce33f8bb806 intitial checkin ca parents: diff changeset	273	fromSpec:aSpec receiver:aReceiver
dce33f8bb806 intitial checkin ca parents: diff changeset	274	\|menu\|
dce33f8bb806 intitial checkin ca parents: diff changeset	275
dce33f8bb806 intitial checkin ca parents: diff changeset	276	aSpec notNil ifTrue:[
1955 dea13bc1f1e0 bug fix when setting the receiver ca parents: 1929 diff changeset	277	menu := Menu new.
dea13bc1f1e0 bug fix when setting the receiver ca parents: 1929 diff changeset	278	menu receiver:aReceiver.
dea13bc1f1e0 bug fix when setting the receiver ca parents: 1929 diff changeset	279	menu fromLiteralArrayEncoding:aSpec.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	280	].
dce33f8bb806 intitial checkin ca parents: diff changeset	281	^ self menu:menu receiver:aReceiver
dce33f8bb806 intitial checkin ca parents: diff changeset	282	!
dce33f8bb806 intitial checkin ca parents: diff changeset	283
dce33f8bb806 intitial checkin ca parents: diff changeset	284	labels:labels
dce33f8bb806 intitial checkin ca parents: diff changeset	285	^ self labels:labels nameKeys:nil receiver:nil
dce33f8bb806 intitial checkin ca parents: diff changeset	286	!
dce33f8bb806 intitial checkin ca parents: diff changeset	287
dce33f8bb806 intitial checkin ca parents: diff changeset	288	labels:labels nameKeys:nameKeys
dce33f8bb806 intitial checkin ca parents: diff changeset	289	^ self labels:labels nameKeys:nameKeys receiver:nil
dce33f8bb806 intitial checkin ca parents: diff changeset	290	!
dce33f8bb806 intitial checkin ca parents: diff changeset	291
dce33f8bb806 intitial checkin ca parents: diff changeset	292	labels:labels nameKeys:nameKeys receiver:aReceiver
dce33f8bb806 intitial checkin ca parents: diff changeset	293	\|mview\|
dce33f8bb806 intitial checkin ca parents: diff changeset	294
dce33f8bb806 intitial checkin ca parents: diff changeset	295	mview := self menu:nil receiver:aReceiver.
dce33f8bb806 intitial checkin ca parents: diff changeset	296	mview labels:labels.
dce33f8bb806 intitial checkin ca parents: diff changeset	297	mview nameKeys:nameKeys.
dce33f8bb806 intitial checkin ca parents: diff changeset	298	^ mview
dce33f8bb806 intitial checkin ca parents: diff changeset	299
dce33f8bb806 intitial checkin ca parents: diff changeset	300	!
dce33f8bb806 intitial checkin ca parents: diff changeset	301
502 dedc1b29b6ac support of arguments ca parents: 498 diff changeset	302	labels:labels receiver:aReceiver
dedc1b29b6ac support of arguments ca parents: 498 diff changeset	303	^ self labels:labels nameKeys:nil receiver:aReceiver
dedc1b29b6ac support of arguments ca parents: 498 diff changeset	304	!
dedc1b29b6ac support of arguments ca parents: 498 diff changeset	305
388 dce33f8bb806 intitial checkin ca parents: diff changeset	306	menu:aMenu
dce33f8bb806 intitial checkin ca parents: diff changeset	307	^ self menu:aMenu receiver:nil
dce33f8bb806 intitial checkin ca parents: diff changeset	308	!
dce33f8bb806 intitial checkin ca parents: diff changeset	309
dce33f8bb806 intitial checkin ca parents: diff changeset	310	menu:aMenu receiver:aReceiver
dce33f8bb806 intitial checkin ca parents: diff changeset	311	\|mview\|
dce33f8bb806 intitial checkin ca parents: diff changeset	312
dce33f8bb806 intitial checkin ca parents: diff changeset	313	mview := self new.
1955 dea13bc1f1e0 bug fix when setting the receiver ca parents: 1929 diff changeset	314
dea13bc1f1e0 bug fix when setting the receiver ca parents: 1929 diff changeset	315	(aMenu notNil and:[aMenu receiver isNil]) ifTrue:[
dea13bc1f1e0 bug fix when setting the receiver ca parents: 1929 diff changeset	316	"/ no receiver specified in the menu; thus set the receiver immediately
dea13bc1f1e0 bug fix when setting the receiver ca parents: 1929 diff changeset	317	mview receiver:aReceiver
dea13bc1f1e0 bug fix when setting the receiver ca parents: 1929 diff changeset	318	].
dea13bc1f1e0 bug fix when setting the receiver ca parents: 1929 diff changeset	319
388 dce33f8bb806 intitial checkin ca parents: diff changeset	320	mview menu:aMenu.
dce33f8bb806 intitial checkin ca parents: diff changeset	321
1955 dea13bc1f1e0 bug fix when setting the receiver ca parents: 1929 diff changeset	322
388 dce33f8bb806 intitial checkin ca parents: diff changeset	323	"/ a menu itself may contain a receiver
dce33f8bb806 intitial checkin ca parents: diff changeset	324	"/ thus we do not overwrite the receiver
dce33f8bb806 intitial checkin ca parents: diff changeset	325
dce33f8bb806 intitial checkin ca parents: diff changeset	326	aReceiver notNil ifTrue:[
1955 dea13bc1f1e0 bug fix when setting the receiver ca parents: 1929 diff changeset	327	mview receiver:aReceiver
388 dce33f8bb806 intitial checkin ca parents: diff changeset	328	].
dce33f8bb806 intitial checkin ca parents: diff changeset	329	^ mview
dce33f8bb806 intitial checkin ca parents: diff changeset	330	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	331
dce33f8bb806 intitial checkin ca parents: diff changeset	332	!MenuPanel class methodsFor:'class initialization'!
dce33f8bb806 intitial checkin ca parents: diff changeset	333
dce33f8bb806 intitial checkin ca parents: diff changeset	334	initialize
657 a8246e896fa3 class initialize routine completed tz parents: 653 diff changeset	335	"
a8246e896fa3 class initialize routine completed tz parents: 653 diff changeset	336	DefaultAdornment := nil.
a8246e896fa3 class initialize routine completed tz parents: 653 diff changeset	337	self initialize
a8246e896fa3 class initialize routine completed tz parents: 653 diff changeset	338	"
a8246e896fa3 class initialize routine completed tz parents: 653 diff changeset	339
388 dce33f8bb806 intitial checkin ca parents: diff changeset	340	InitialSelectionQuerySignal isNil ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	341	InitialSelectionQuerySignal := QuerySignal new.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	342	].
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	343
388 dce33f8bb806 intitial checkin ca parents: diff changeset	344	DefaultAdornment isNil ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	345	DefaultAdornment := IdentityDictionary new
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	346	at:#showSeparatingLines put:false;
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	347	at:#showGroupDivider put:true;
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	348	at:#verticalLayout put:true;
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	349	at:#item put:nil;
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	350	at:#value put:nil;
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	351	yourself
388 dce33f8bb806 intitial checkin ca parents: diff changeset	352	].
dce33f8bb806 intitial checkin ca parents: diff changeset	353
660 d1670dfe5445 Do not call #updateStyleCache from #initialize. Stefan Vogel <sv@exept.de> parents: 658 diff changeset	354	"Modified: / 15.1.1998 / 23:08:31 / stefan"
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	355	!
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	356
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	357	preSnapshot
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	358	"remove all resources
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	359	"
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	360	Images := nil.
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	361	LigthenedImages := nil.
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	362
616 a6157b083830 support of different styles ca parents: 608 diff changeset	363	! !
a6157b083830 support of different styles ca parents: 608 diff changeset	364
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	365	!MenuPanel class methodsFor:'default icons'!
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	366
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	367	iconIndicationDisabledOff
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	368	"This resource specification was automatically generated
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	369	by the ImageEditor of ST/X."
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	370
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	371	"Do not manually edit this!! If it is corrupted,
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	372	the ImageEditor may not be able to read the specification."
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	373
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	374	"
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	375	self iconIndicationDisabledOff inspect
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	376	ImageEditor openOnClass:self andSelector:#iconIndicationDisabledOff
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	377	"
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	378
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	379	<resource: #image>
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	380
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	381	^Icon
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	382	constantNamed:#'MenuPanel iconIndicationDisabledOff'
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	383	ifAbsentPut:[(Depth2Image new) width: 14; height: 14; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'UUUUPG???8A:*@^* G*(A:@^ G(A:@^* G*(A:@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]
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	384	!
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	385
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	386	iconIndicationDisabledOn
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	387	"This resource specification was automatically generated
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	388	by the ImageEditor of ST/X."
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	389
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	390	"Do not manually edit this!! If it is corrupted,
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	391	the ImageEditor may not be able to read the specification."
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	392
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	393	"
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	394	self iconIndicationDisabledOn inspect
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	395	ImageEditor openOnClass:self andSelector:#iconIndicationDisabledOn
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	396	"
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	397
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	398	<resource: #image>
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	399
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	400	^Icon
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	401	constantNamed:#'MenuPanel iconIndicationDisabledOn'
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	402	ifAbsentPut:[(Depth2Image new) width: 14; height: 14; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'****$H@@@MBO???P#???4H??<=BO?<OP#O<C4H0<C=BL@C?P#0C?4H?C?=BO???P/???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]
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	403	!
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	404
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	405	iconIndicationOff
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	406	"This resource specification was automatically generated
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	407	by the ImageEditor of ST/X."
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	408
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	409	"Do not manually edit this!! If it is corrupted,
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	410	the ImageEditor may not be able to read the specification."
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	411
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	412	"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	413	self iconIndicationOff inspect
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	414	ImageEditor openOnClass:self andSelector:#iconIndicationOff
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	415	"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	416
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	417	<resource: #image>
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	418
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	419	^Icon
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	420	constantNamed:#'MenuPanel iconIndicationOff'
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	421	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]
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	422	!
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	423
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	424	iconIndicationOn
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	425	"This resource specification was automatically generated
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	426	by the ImageEditor of ST/X."
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	427
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	428	"Do not manually edit this!! If it is corrupted,
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	429	the ImageEditor may not be able to read the specification."
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	430
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	431	"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	432	self iconIndicationOn inspect
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	433	ImageEditor openOnClass:self andSelector:#iconIndicationOn
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	434	"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	435
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	436	<resource: #image>
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	437
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	438	^Icon
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	439	constantNamed:#'MenuPanel iconIndicationOn'
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	440	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]
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	441	!
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	442
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	443	iconRadioGroupDisabledOff
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	444	"This resource specification was automatically generated
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	445	by the ImageEditor of ST/X."
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	446
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	447	"Do not manually edit this!! If it is corrupted,
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	448	the ImageEditor may not be able to read the specification."
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	449
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	450	"
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	451	self iconRadioGroupDisabledOff inspect
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	452	ImageEditor openOnClass:self andSelector:#iconRadioGroupDisabledOff
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	453	"
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	454
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	455	<resource: #image>
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	456
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	457	^Icon
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	458	constantNamed:#'MenuPanel iconRadioGroupDisabledOff'
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	459	ifAbsentPut:[(Depth2Image new) width: 15; height: 15; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@AUP@@E@AP@DJY@DZ(AJ+AJLR#D(1JLR#AZ#@Z(0A 0@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]
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	460	!
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	461
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	462	iconRadioGroupDisabledOn
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	463	"This resource specification was automatically generated
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	464	by the ImageEditor of ST/X."
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	465
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	466	"Do not manually edit this!! If it is corrupted,
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	467	the ImageEditor may not be able to read the specification."
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	468
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	469	"
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	470	self iconRadioGroupDisabledOn inspect
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	471	ImageEditor openOnClass:self andSelector:#iconRadioGroupDisabledOn
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	472	"
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	473
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	474	<resource: #image>
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	475
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	476	^Icon
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	477	constantNamed:#'MenuPanel iconRadioGroupDisabledOn'
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	478	ifAbsentPut:[(Depth2Image new) width: 15; height: 15; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@AUP@@E@AP@DJY@DY@Z(AH@@+AI@@FLR@@@#D @@H1H@@BLRP@A#AX@@#@Z$A(0A* 0@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]
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	479	!
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	480
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	481	iconRadioGroupOff
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	482	"This resource specification was automatically generated
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	483	by the ImageEditor of ST/X."
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	484
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	485	"Do not manually edit this!! If it is corrupted,
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	486	the ImageEditor may not be able to read the specification."
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	487
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	488	"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	489	self iconRadioGroupOff inspect
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	490	ImageEditor openOnClass:self andSelector:#iconRadioGroupOff
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	491	"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	492
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	493	<resource: #image>
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	494
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	495	^Icon
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	496	constantNamed:#'MenuPanel iconRadioGroupOff'
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	497	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]
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	498	!
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	499
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	500	iconRadioGroupOn
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	501	"This resource specification was automatically generated
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	502	by the ImageEditor of ST/X."
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	503
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	504	"Do not manually edit this!! If it is corrupted,
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	505	the ImageEditor may not be able to read the specification."
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	506
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	507	"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	508	self iconRadioGroupOn inspect
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	509	ImageEditor openOnClass:self andSelector:#iconRadioGroupOn
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	510	"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	511
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	512	<resource: #image>
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	513
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	514	^Icon
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	515	constantNamed:#'MenuPanel iconRadioGroupOn'
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	516	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]
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	517	! !
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	518
616 a6157b083830 support of different styles ca parents: 608 diff changeset	519	!MenuPanel class methodsFor:'defaults'!
450 ac72eb2ed895 initialize fix Claus Gittinger <cg@exept.de> parents: 441 diff changeset	520
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	521	defaultBackgroundColor
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	522	^ DefaultBackgroundColor
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	523	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	524
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	525	defaultLevel
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	526	^ DefaultLevel
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	527	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	528
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	529	mnemonicIdentifier
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	530	"returns the identifier each mnemonic starts with;
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	531	ex:
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	532	&File mnemonic := Cmdf
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	533	F&ile mnemonic := Cmdi
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	534	.....
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	535	"
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	536	^ 'Cmd'
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	537	!
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	538
450 ac72eb2ed895 initialize fix Claus Gittinger <cg@exept.de> parents: 441 diff changeset	539	updateStyleCache
657 a8246e896fa3 class initialize routine completed tz parents: 653 diff changeset	540
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	541	<resource: #style (#'menu.foregroundColor' #'menu.backgroundColor'
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	542	#'menu.hilightForegroundColor' #'menu.hilightBackgroundColor'
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	543	#'menu.disabledForegroundColor' #'menu.disabledEtchedForegroundColor'
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	544	#'menu.buttonEnteredBackgroundColor'
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	545	#'menu.hilightLevel' #'menu.groupDividerSize'
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	546	#'menu.itemSpace' #'menu.buttonItemSpace'
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	547	#'menu.fitFirstPanel' #'menu.buttonActiveLevel'
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	548	#'menu.buttonPassiveLevel' #'menu.buttonEnteredLevel'
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	549	#'menu.selectionFollowsMouse' #'menu.enteredLevel'
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	550	#'viewBackground'
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	551	#'pullDownMenu.level'
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	552	#'pullDownMenu.hilightLevel'
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	553	#'button.disabledForegroundColor' #'button.disabledEtchedForegroundColor'
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	554	#'button.enteredBackgroundColor'
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	555	#'button.activeBackgroundColor' #'button.backgroundColor'
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	556	#'button.lightColor' #'button.shadowColor'
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	557	#'button.halfLightColor' #'button.halfShadowColor'
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	558	#'button.passiveLevel' #'button.activeLevel'
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	559	#'button.edgeStyle')>
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	560
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	561
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	562	\|style styleSheet\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	563
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	564	styleSheet := StyleSheet.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	565	style := styleSheet name.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	566
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	567	DefaultForegroundColor := styleSheet colorAt:#'menu.foregroundColor'
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	568	default:Color black.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	569
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	570	DefaultBackgroundColor := styleSheet colorAt:#'menu.backgroundColor'
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	571	default:DefaultViewBackgroundColor.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	572
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	573	DefaultHilightForegroundColor := styleSheet colorAt:#'menu.hilightForegroundColor'.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	574
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	575	DefaultHilightForegroundColor isNil ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	576	styleSheet is3D ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	577	DefaultHilightForegroundColor := DefaultForegroundColor.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	578	] ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	579	DefaultHilightForegroundColor := DefaultBackgroundColor.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	580	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	581	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	582
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	583	DefaultDisabledForegroundColor := styleSheet colorAt:#'menu.disabledForegroundColor'.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	584	DefaultDisabledForegroundColor isNil ifTrue:[
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	585	DefaultDisabledForegroundColor := styleSheet colorAt:#'selection.disabledForegroundColor'.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	586	DefaultDisabledForegroundColor isNil ifTrue:[
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	587	DefaultDisabledForegroundColor := styleSheet colorAt:#'button.disabledForegroundColor'
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	588	default:Color darkGray.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	589	]
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	590	].
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	591	DefaultDisabledEtchedForegroundColor := styleSheet colorAt:#'menu.disabledEtchedForegroundColor'.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	592	DefaultDisabledEtchedForegroundColor isNil ifTrue:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	593	DefaultDisabledEtchedForegroundColor := styleSheet colorAt:#'button.disabledEtchedForegroundColor'.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	594	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	595
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	596	DefaultHilightBackgroundColor := styleSheet colorAt:#'menu.hilightBackgroundColor'.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	597
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	598	DefaultHilightBackgroundColor isNil ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	599	style == #motif ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	600	DefaultHilightBackgroundColor := DefaultBackgroundColor
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	601	] ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	602	DefaultHilightBackgroundColor := styleSheet is3D ifFalse:[DefaultForegroundColor]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	603	ifTrue:[DefaultBackgroundColor]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	604	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	605	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	606
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	607	DefaultLevel := styleSheet at:#'menuPanel.level' default:nil.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	608	DefaultLevel isNil ifTrue:[
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	609	DefaultLevel := styleSheet at:#'pullDownMenu.level' default:1.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	610	"/ styleSheet is3D ifTrue:[DefaultLevel := DefaultLevel + 1].
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	611	].
1337 f0ed36b3c3d6 style fixes Claus Gittinger <cg@exept.de> parents: 1336 diff changeset	612
616 a6157b083830 support of different styles ca parents: 608 diff changeset	613	(style == #motif or:[style == #iris]) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	614	DefaultHilightLevel := 2.
616 a6157b083830 support of different styles ca parents: 608 diff changeset	615	] ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	616	(DefaultHilightLevel := styleSheet at:'pullDownMenu.hilightLevel') isNil ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	617	DefaultHilightLevel := styleSheet at:'menu.hilightLevel' default:0.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	618	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	619	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	620
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	621	DefaultGroupDividerSize := styleSheet at:#'menu.groupDividerSize' default:6.
1723 f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	622	DefaultItemSpace := styleSheet at:#'menu.itemSpace' default:2.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	623	DefaultButtonItemSpace := styleSheet at:#'menu.buttonItemSpace' default:0.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	624	DefaultFitFirstPanel := styleSheet at:#'menu.fitFirstPanel' default:true.
616 a6157b083830 support of different styles ca parents: 608 diff changeset	625
829 c86ed87da63b bug fix: ca parents: 828 diff changeset	626	MenuView updateStyleCache.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	627	DefaultFont := MenuView defaultFont.
616 a6157b083830 support of different styles ca parents: 608 diff changeset	628	RightArrowForm := SelectionInListView rightArrowFormOn:Display.
a6157b083830 support of different styles ca parents: 608 diff changeset	629
1054 f56416a8d26b win95 has no 3D right-arrow for subMenus. Claus Gittinger <cg@exept.de> parents: 1051 diff changeset	630	(style ~~ #os2 and:[style ~~ #win95]) ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	631	RightArrowShadowForm := SelectionInListView rightArrowShadowFormOn:Display.
616 a6157b083830 support of different styles ca parents: 608 diff changeset	632	] ifFalse:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	633	RightArrowShadowForm := nil
616 a6157b083830 support of different styles ca parents: 608 diff changeset	634	].
a6157b083830 support of different styles ca parents: 608 diff changeset	635
730 9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	636	SelectionFrameBrightColor := Color white.
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	637	SelectionFrameDarkColor := Color black.
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	638
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	639	ButtonActiveLevel := styleSheet at:#'menu.buttonActiveLevel' default:(styleSheet is3D ifTrue:[-2] ifFalse:[0]).
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	640	ButtonActiveLevel isNil ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	641	ButtonActiveLevel := styleSheet at:#'button.activeLevel' default:(styleSheet is3D ifTrue:[-2] ifFalse:[0]).
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	642	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	643	ButtonPassiveLevel := styleSheet at:#'menu.buttonPassiveLevel'.
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	644	ButtonPassiveLevel isNil ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	645	ButtonPassiveLevel := styleSheet at:#'button.passiveLevel' default:(styleSheet is3D ifTrue:[2] ifFalse:[0]).
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	646	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	647	ButtonActiveBackgroundColor := styleSheet at:#'button.activeBackgroundColor' default: DefaultBackgroundColor.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	648	ButtonPassiveBackgroundColor := (styleSheet at:#'button.backgroundColor') ? (styleSheet at:'viewBackground') ? DefaultBackgroundColor.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	649
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	650	ButtonLightColor := styleSheet at:#'button.lightColor'.
1336 6087005f59a8 checkin from browser Claus Gittinger <cg@exept.de> parents: 1332 diff changeset	651	ButtonLightColor isNil ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	652	ButtonLightColor := (ButtonPassiveBackgroundColor averageColorIn:(0@0 corner:7@7)) lightened. "/ Color white
1336 6087005f59a8 checkin from browser Claus Gittinger <cg@exept.de> parents: 1332 diff changeset	653	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	654	ButtonShadowColor := styleSheet at:#'button.shadowColor'.
1336 6087005f59a8 checkin from browser Claus Gittinger <cg@exept.de> parents: 1332 diff changeset	655	ButtonShadowColor isNil ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	656	ButtonShadowColor := (ButtonPassiveBackgroundColor averageColorIn:(0@0 corner:7@7)) darkened. "/ Color white
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	657	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	658	ButtonHalfLightColor := styleSheet at:#'button.halfLightColor'.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	659	ButtonHalfShadowColor := styleSheet at:#'button.halfShadowColor'.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	660	ButtonEdgeStyle := styleSheet at:#'button.edgeStyle'.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	661
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	662	ButtonEnteredBackgroundColor := styleSheet colorAt:#'menu.buttonEnteredBackgroundColor'.
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	663	ButtonEnteredBackgroundColor isNil ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	664	ButtonEnteredBackgroundColor := styleSheet colorAt:#'button.enteredBackgroundColor'
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	665	default:ButtonPassiveBackgroundColor.
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	666	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	667	ButtonEnteredLevel := styleSheet at:#'menu.buttonEnteredLevel' default:ButtonPassiveLevel.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	668
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	669	DefaultSelectionFollowsMouse := styleSheet at:#'menu.selectionFollowsMouse' default:false.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	670	DefaultEnteredLevel := styleSheet at:#'menu.enteredLevel' default:0.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	671
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	672	ShortcutKeyOffset := 5.
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	673	DefaultOpenOnSelect := styleSheet at:#'menu.openOnSelect' default:false.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	674
616 a6157b083830 support of different styles ca parents: 608 diff changeset	675	Item updateStyleCache
1018 67c883ab05d6 kludge fixes for normal style. Claus Gittinger <cg@exept.de> parents: 1010 diff changeset	676
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	677	"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	678	self updateStyleCache
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	679	"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	680
1130 fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	681	"Modified: / 10.9.1998 / 21:40:32 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	682	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	683
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	684	!MenuPanel class methodsFor:'image registration'!
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	685
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	686	image:anImage onDevice:aDevice
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	687	"
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	688	Images := nil
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	689	"
1097 8a2f6c5ad1a9 * empty log message * Claus Gittinger <cg@exept.de> parents: 1096 diff changeset	690	\|deviceImages image\|
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	691
1156 6fa33dc93509 fix to avoid repeated image>>onDevice Claus Gittinger <cg@exept.de> parents: 1151 diff changeset	692	anImage device == aDevice ifTrue:[
1853 399e2eac3b99 Use WeakIdentityDictionaries to cache images per Workstation. Stefan Vogel <sv@exept.de> parents: 1841 diff changeset	693	^ anImage
399e2eac3b99 Use WeakIdentityDictionaries to cache images per Workstation. Stefan Vogel <sv@exept.de> parents: 1841 diff changeset	694	].
399e2eac3b99 Use WeakIdentityDictionaries to cache images per Workstation. Stefan Vogel <sv@exept.de> parents: 1841 diff changeset	695
399e2eac3b99 Use WeakIdentityDictionaries to cache images per Workstation. Stefan Vogel <sv@exept.de> parents: 1841 diff changeset	696	Images isNil ifTrue:[ Images := WeakIdentityDictionary new ].
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	697
1097 8a2f6c5ad1a9 * empty log message * Claus Gittinger <cg@exept.de> parents: 1096 diff changeset	698	(deviceImages := Images at:aDevice ifAbsent:nil) isNil ifTrue:[
1853 399e2eac3b99 Use WeakIdentityDictionaries to cache images per Workstation. Stefan Vogel <sv@exept.de> parents: 1841 diff changeset	699	Images at:aDevice put:(deviceImages := Dictionary new)
1097 8a2f6c5ad1a9 * empty log message * Claus Gittinger <cg@exept.de> parents: 1096 diff changeset	700	].
8a2f6c5ad1a9 * empty log message * Claus Gittinger <cg@exept.de> parents: 1096 diff changeset	701
8a2f6c5ad1a9 * empty log message * Claus Gittinger <cg@exept.de> parents: 1096 diff changeset	702	(image := deviceImages at:anImage ifAbsent:nil) notNil ifTrue:[
1853 399e2eac3b99 Use WeakIdentityDictionaries to cache images per Workstation. Stefan Vogel <sv@exept.de> parents: 1841 diff changeset	703	^ image
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	704	].
798 74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	705
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	706	image := anImage copy onDevice:aDevice.
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	707	image clearMaskedPixels.
1097 8a2f6c5ad1a9 * empty log message * Claus Gittinger <cg@exept.de> parents: 1096 diff changeset	708	deviceImages at:anImage put:image.
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	709	^ image
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	710
1156 6fa33dc93509 fix to avoid repeated image>>onDevice Claus Gittinger <cg@exept.de> parents: 1151 diff changeset	711	"Modified: / 29.9.1998 / 12:02:41 / cg"
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	712	!
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	713
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	714	lightenedImage:anImage onDevice:aDevice
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	715	"
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	716	LigthenedImages := nil
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	717	"
1097 8a2f6c5ad1a9 * empty log message * Claus Gittinger <cg@exept.de> parents: 1096 diff changeset	718	\|deviceImages image\|
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	719
1853 399e2eac3b99 Use WeakIdentityDictionaries to cache images per Workstation. Stefan Vogel <sv@exept.de> parents: 1841 diff changeset	720	LigthenedImages isNil ifTrue:[ LigthenedImages := WeakIdentityDictionary new ].
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	721
1097 8a2f6c5ad1a9 * empty log message * Claus Gittinger <cg@exept.de> parents: 1096 diff changeset	722	(deviceImages := LigthenedImages at:aDevice ifAbsent:nil) isNil ifTrue:[
1853 399e2eac3b99 Use WeakIdentityDictionaries to cache images per Workstation. Stefan Vogel <sv@exept.de> parents: 1841 diff changeset	723	LigthenedImages at:aDevice put:(deviceImages := Dictionary new)
1097 8a2f6c5ad1a9 * empty log message * Claus Gittinger <cg@exept.de> parents: 1096 diff changeset	724	].
8a2f6c5ad1a9 * empty log message * Claus Gittinger <cg@exept.de> parents: 1096 diff changeset	725
8a2f6c5ad1a9 * empty log message * Claus Gittinger <cg@exept.de> parents: 1096 diff changeset	726	(image := deviceImages at:anImage ifAbsent:nil) notNil ifTrue:[
1853 399e2eac3b99 Use WeakIdentityDictionaries to cache images per Workstation. Stefan Vogel <sv@exept.de> parents: 1841 diff changeset	727	^ image
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	728	].
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	729
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	730	((anImage respondsTo:#colorMap) and:[anImage colorMap notNil]) ifTrue:[
1853 399e2eac3b99 Use WeakIdentityDictionaries to cache images per Workstation. Stefan Vogel <sv@exept.de> parents: 1841 diff changeset	731	image := anImage copy lightened onDevice:aDevice.
399e2eac3b99 Use WeakIdentityDictionaries to cache images per Workstation. Stefan Vogel <sv@exept.de> parents: 1841 diff changeset	732	image clearMaskedPixels.
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	733	] ifFalse:[
1853 399e2eac3b99 Use WeakIdentityDictionaries to cache images per Workstation. Stefan Vogel <sv@exept.de> parents: 1841 diff changeset	734	image := self image:anImage onDevice:aDevice
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	735	].
1097 8a2f6c5ad1a9 * empty log message * Claus Gittinger <cg@exept.de> parents: 1096 diff changeset	736	deviceImages at:anImage put:image.
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	737	^ image
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	738
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	739
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	740	! !
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	741
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	742	!MenuPanel class methodsFor:'private'!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	743
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	744	subMenu:aSubMenu
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	745	"create a submenu; can be redifined in derived classes
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	746	"
1063 08b7ca464437 dont show accelerators for horizontal layouts Claus Gittinger <cg@exept.de> parents: 1054 diff changeset	747	^ (self new) menu:aSubMenu.
08b7ca464437 dont show accelerators for horizontal layouts Claus Gittinger <cg@exept.de> parents: 1054 diff changeset	748
08b7ca464437 dont show accelerators for horizontal layouts Claus Gittinger <cg@exept.de> parents: 1054 diff changeset	749	"Modified: / 8.8.1998 / 02:13:11 / cg"
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	750	! !
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	751
1808 e8628b502a49 methodCategory change Claus Gittinger <cg@exept.de> parents: 1806 diff changeset	752	!MenuPanel methodsFor:'accepting'!
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	753
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	754	accept
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	755	"accept current selected item
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	756	"
1670 dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	757	^ self acceptItem:(self selection) inMenu:self
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	758	!
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	759
1836 89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	760	accept:anItem
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	761	"this is the topMenu: accept item
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	762	"
2050 ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	763	\|value item tgState itemIdx recv panel masterGroup winGrp acceptAction\|
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	764
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	765	self superMenu notNil ifTrue:[
1382 a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	766	^ self topMenu accept:anItem
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	767	].
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	768	self scrollActivity stop.
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	769	self selection:nil.
420 b6f9fff472ef fixes ca parents: 417 diff changeset	770
b6f9fff472ef fixes ca parents: 417 diff changeset	771	(anItem notNil and:[anItem canAccept]) ifTrue:[
1382 a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	772	tgState := anItem toggleIndication.
a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	773	panel := anItem menuPanel.
a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	774	itemIdx := panel findFirst:[:el\| el == anItem ].
a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	775	item := anItem.
a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	776	recv := panel receiver.
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	777	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	778	self doUngrab:true.
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	779
510 8f77b9382066 bug fix with redraw ca parents: 505 diff changeset	780	self isPopUpView ifFalse:[
1382 a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	781	self do:[:el\| el updateIndicators].
a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	782	self windowGroup processExposeEvents.
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	783	] ifTrue:[
1382 a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	784	self unmap.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	785	(winGrp := self windowGroup) notNil ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	786	"/ give expose event a chance to arrive
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	787	[shown and:[realized]] whileTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	788	winGrp processExposeEventsFor:self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	789	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	790	masterGroup := winGrp previousGroup.
1382 a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	791	].
2050 ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	792	"/ cg: disabled-not needed - try PopUpList with destroy...
ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	793	"/ self destroy.
1382 a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	794	masterGroup notNil ifTrue:[masterGroup processExposeEvents].
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	795	].
1710 bb9bb814e7c4 showBusy code moved Claus Gittinger <cg@exept.de> parents: 1709 diff changeset	796
2050 ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	797	acceptAction := [ value := self accept:item index:itemIdx toggle:tgState receiver:recv ].
ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	798
1710 bb9bb814e7c4 showBusy code moved Claus Gittinger <cg@exept.de> parents: 1709 diff changeset	799	(item notNil
bb9bb814e7c4 showBusy code moved Claus Gittinger <cg@exept.de> parents: 1709 diff changeset	800	and:[item showBusyCursorWhilePerforming
bb9bb814e7c4 showBusy code moved Claus Gittinger <cg@exept.de> parents: 1709 diff changeset	801	and:[(winGrp := (masterGroup ? (self windowGroup))) notNil]])
bb9bb814e7c4 showBusy code moved Claus Gittinger <cg@exept.de> parents: 1709 diff changeset	802	ifTrue:[
2050 ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	803	winGrp withWaitCursorDo:acceptAction
2132 fd5b29a20fe1 * empty log message * Claus Gittinger <cg@exept.de> parents: 2125 diff changeset	804	] ifFalse:[acceptAction value].
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	805
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	806	self isPopUpView ifTrue:[
1382 a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	807	self menuAdornmentAt:#value put:value.
a852ac554869 oops - query for shown is not enough to wait for a view to Claus Gittinger <cg@exept.de> parents: 1368 diff changeset	808	self menuAdornmentAt:#item put:item.
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	809	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	810	^ item.
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	811
2050 ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	812	"Modified: / 15.11.2001 / 17:05:40 / cg"
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	813	!
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	814
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	815	accept:anItem index:anIndex toggle:aState receiver:aReceiver
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	816	"accept an item
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	817	"
1679 af40842718f6 when accepting, and the application does not respond to that Claus Gittinger <cg@exept.de> parents: 1670 diff changeset	818	\|value argument numArgs isKindOfValueModel rec args arg2
1697 345d3664e10c added 'showBusyCursorWhileActive' attribute Claus Gittinger <cg@exept.de> parents: 1695 diff changeset	819	app master fallBack\|
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	820
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	821	anItem isNil ifTrue:[
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	822	self menuAdornmentAt:#hasPerformed put:true.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	823	^ nil
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	824	].
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	825
1219 6a0d677a6fac removed some #isKindOf: calls. Claus Gittinger <cg@exept.de> parents: 1218 diff changeset	826	self menuAdornmentAt:#hasPerformed put:(aReceiver isValueModel).
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	827
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	828	(value := anItem value) isNil ifTrue:[
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	829	^ anIndex
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	830	].
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	831
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	832	(argument := anItem argument) isNil ifTrue:[
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	833	argument := aState ? anItem
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	834	].
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	835
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	836	value isSymbol ifFalse:[
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	837	"/ a valueHolder or block
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	838	(value respondsTo:#valueWithArguments:) ifFalse:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	839	^ value
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	840	].
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	841
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	842	numArgs := value perform:#numArgs ifNotUnderstood:0.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	843
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	844	numArgs == 0 ifTrue:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	845	args := nil
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	846	] ifFalse:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	847	numArgs == 1 ifTrue:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	848	args := Array with:argument
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	849	] ifFalse:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	850	args := Array with:argument with:self
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	851	]
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	852	].
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	853
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	854	value valueWithArguments:args.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	855
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	856	self menuAdornmentAt:#hasPerformed put:true.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	857	^ anIndex
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	858	].
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	859
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	860	aReceiver isNil ifTrue:[
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	861	^ value
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	862	].
1270 0ae582fd7294 send menuMessage to application, Claus Gittinger <cg@exept.de> parents: 1267 diff changeset	863
1219 6a0d677a6fac removed some #isKindOf: calls. Claus Gittinger <cg@exept.de> parents: 1218 diff changeset	864	isKindOfValueModel := aReceiver isValueModel.
1270 0ae582fd7294 send menuMessage to application, Claus Gittinger <cg@exept.de> parents: 1267 diff changeset	865	isKindOfValueModel ifTrue:[
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	866	aReceiver value:value
465 67a0f3dd503a in case of performing a selector '0' is returned ca parents: 464 diff changeset	867	] ifFalse:[
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	868	rec := aReceiver.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	869	arg2 := self.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	870
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	871	"/ support for ST80 style applications
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	872	"/ (expecting the message to go to the application
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	873	"/ if not understood by the view)
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	874	"/ These expect the controller to be passed as argument.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	875	"/ sigh.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	876
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	877	(aReceiver isView
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	878	and:[(aReceiver respondsTo:value) not
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	879	and:[(app := aReceiver application) ~~ aReceiver
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	880	and:[app notNil]]]) ifTrue:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	881	rec := app.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	882	arg2 := aReceiver controller "/ the Views controller
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	883	].
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	884
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	885	(numArgs := value numArgs) == 0 ifTrue:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	886	args := nil
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	887	] ifFalse:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	888	numArgs == 1 ifTrue:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	889	args := Array with:argument
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	890	] ifFalse:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	891	args := Array with:argument with:arg2
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	892	]
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	893	].
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	894
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	895	fallBack :=
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	896	[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	897	"/ mhmh - the receiver did not respond to that message;
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	898	"/ if there is a master-application, try that one
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	899	"/ (recursive)
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	900	master := rec perform:#masterApplication ifNotUnderstood:nil.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	901	master notNil ifTrue:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	902	rec := master.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	903	rec perform:value withArguments:args ifNotUnderstood:fallBack
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	904	] ifFalse:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	905	self
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	906	error:'unimplemented (or error in) menu message: ' , value
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	907	mayProceed:true
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	908	].
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	909	].
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	910
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	911	rec perform:value withArguments:args ifNotUnderstood:fallBack.
420 b6f9fff472ef fixes ca parents: 417 diff changeset	912	].
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	913	self menuAdornmentAt:#hasPerformed put:true.
1270 0ae582fd7294 send menuMessage to application, Claus Gittinger <cg@exept.de> parents: 1267 diff changeset	914	^ value
1679 af40842718f6 when accepting, and the application does not respond to that Claus Gittinger <cg@exept.de> parents: 1670 diff changeset	915
1719 ba7ebb56e6fd recursively try masterApps when performing Claus Gittinger <cg@exept.de> parents: 1715 diff changeset	916	"Modified: / 19.2.2000 / 11:08:22 / cg"
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	917	!
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	918
1670 dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	919	acceptItem:anItem inMenu:aMenu
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	920	\|tgState\|
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	921
1841 5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	922	(anItem isNil or:[anItem hideMenuOnActivated]) ifTrue:[
1670 dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	923	self topMenu accept:anItem
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	924	] ifFalse:[
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	925	anItem canAccept ifTrue:[
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	926	tgState := anItem toggleIndication.
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	927
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	928	self accept:anItem
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	929	index:(aMenu selectionIndex)
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	930	toggle:tgState
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	931	receiver:(aMenu receiver).
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	932
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	933	aMenu do:[:el\| el updateIndicators].
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	934	]
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	935	]
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	936	!
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	937
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	938	lastItemAccepted
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	939	"returns last item selected or nil
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	940	"
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	941	^ self topMenu menuAdornmentAt:#item
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	942	!
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	943
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	944	lastValueAccepted
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	945	"returns last value accepted or nil
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	946	"
971 c000e2691543 fixed #lastValueSelected Claus Gittinger <cg@exept.de> parents: 963 diff changeset	947	^ (self lastItemAccepted) value
c000e2691543 fixed #lastValueSelected Claus Gittinger <cg@exept.de> parents: 963 diff changeset	948	"/ \|top\|
c000e2691543 fixed #lastValueSelected Claus Gittinger <cg@exept.de> parents: 963 diff changeset	949	"/
c000e2691543 fixed #lastValueSelected Claus Gittinger <cg@exept.de> parents: 963 diff changeset	950	"/ top := self topMenu.
c000e2691543 fixed #lastValueSelected Claus Gittinger <cg@exept.de> parents: 963 diff changeset	951	"/
c000e2691543 fixed #lastValueSelected Claus Gittinger <cg@exept.de> parents: 963 diff changeset	952	"/ (top menuAdornmentAt:#hasPerformed) == true ifTrue:[
c000e2691543 fixed #lastValueSelected Claus Gittinger <cg@exept.de> parents: 963 diff changeset	953	"/ ^ self topMenu menuAdornmentAt:#value.
c000e2691543 fixed #lastValueSelected Claus Gittinger <cg@exept.de> parents: 963 diff changeset	954	"/ ].
c000e2691543 fixed #lastValueSelected Claus Gittinger <cg@exept.de> parents: 963 diff changeset	955	"/ ^ nil
c000e2691543 fixed #lastValueSelected Claus Gittinger <cg@exept.de> parents: 963 diff changeset	956
c000e2691543 fixed #lastValueSelected Claus Gittinger <cg@exept.de> parents: 963 diff changeset	957	"Modified: / 18.6.1998 / 23:37:09 / cg"
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	958	! !
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	959
388 dce33f8bb806 intitial checkin ca parents: diff changeset	960	!MenuPanel methodsFor:'accessing'!
dce33f8bb806 intitial checkin ca parents: diff changeset	961
dce33f8bb806 intitial checkin ca parents: diff changeset	962	accessCharacterPositionAt:stringOrNumber
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	963	"get the access character position for a textLabel
388 dce33f8bb806 intitial checkin ca parents: diff changeset	964	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	965	^ self itemAt:stringOrNumber do:[:el\| el accessCharacterPosition ]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	966	!
dce33f8bb806 intitial checkin ca parents: diff changeset	967
dce33f8bb806 intitial checkin ca parents: diff changeset	968	accessCharacterPositionAt:stringOrNumber put:anIndexOrNil
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	969	"get the access character position for a textLabel
388 dce33f8bb806 intitial checkin ca parents: diff changeset	970	"
dce33f8bb806 intitial checkin ca parents: diff changeset	971	self itemAt:stringOrNumber do:[:el\| el accessCharacterPosition:anIndexOrNil ]
dce33f8bb806 intitial checkin ca parents: diff changeset	972	!
dce33f8bb806 intitial checkin ca parents: diff changeset	973
dce33f8bb806 intitial checkin ca parents: diff changeset	974	accessCharacterPositions
dce33f8bb806 intitial checkin ca parents: diff changeset	975	"returns a collection of accessCharacterPosition's or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	976	"
dce33f8bb806 intitial checkin ca parents: diff changeset	977	^ self collect:[:anItem\| anItem accessCharacterPosition ]
dce33f8bb806 intitial checkin ca parents: diff changeset	978
dce33f8bb806 intitial checkin ca parents: diff changeset	979	!
dce33f8bb806 intitial checkin ca parents: diff changeset	980
dce33f8bb806 intitial checkin ca parents: diff changeset	981	accessCharacterPositions:something
dce33f8bb806 intitial checkin ca parents: diff changeset	982	"define accessCharacterPosition's for each item
dce33f8bb806 intitial checkin ca parents: diff changeset	983	"
dce33f8bb806 intitial checkin ca parents: diff changeset	984	self onEachPerform:#accessCharacterPosition: withArgList:something
dce33f8bb806 intitial checkin ca parents: diff changeset	985	!
dce33f8bb806 intitial checkin ca parents: diff changeset	986
dce33f8bb806 intitial checkin ca parents: diff changeset	987	args
dce33f8bb806 intitial checkin ca parents: diff changeset	988	"returns a collection of argument's or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	989	"
dce33f8bb806 intitial checkin ca parents: diff changeset	990	^ self collect:[:anItem\| anItem argument ]
dce33f8bb806 intitial checkin ca parents: diff changeset	991	!
dce33f8bb806 intitial checkin ca parents: diff changeset	992
dce33f8bb806 intitial checkin ca parents: diff changeset	993	args:something
dce33f8bb806 intitial checkin ca parents: diff changeset	994	"define arguments for each item
dce33f8bb806 intitial checkin ca parents: diff changeset	995	"
dce33f8bb806 intitial checkin ca parents: diff changeset	996	self onEachPerform:#argument: withArgList:something
dce33f8bb806 intitial checkin ca parents: diff changeset	997	!
dce33f8bb806 intitial checkin ca parents: diff changeset	998
dce33f8bb806 intitial checkin ca parents: diff changeset	999	argsAt:stringOrNumber
dce33f8bb806 intitial checkin ca parents: diff changeset	1000	"gets the argument of an item or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	1001	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1002	^ self itemAt:stringOrNumber do:[:el\| el argument ]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1003	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1004
dce33f8bb806 intitial checkin ca parents: diff changeset	1005	argsAt:stringOrNumber put:anArgument
dce33f8bb806 intitial checkin ca parents: diff changeset	1006	"sets the argument of an item
dce33f8bb806 intitial checkin ca parents: diff changeset	1007	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1008	self itemAt:stringOrNumber do:[:el\| el argument:anArgument ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1009	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1010
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1011	enteredItem
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1012	"return the item over which the mouse pointer is located;
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1013	nil if the mouse is not over any item"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1014
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1015	^ enteredItem
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1016
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1017	"Created: / 20.8.1998 / 13:12:34 / cg"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1018	!
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1019
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1020	groupSizes
dce33f8bb806 intitial checkin ca parents: diff changeset	1021	"gets collection of group sizes
dce33f8bb806 intitial checkin ca parents: diff changeset	1022	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1023	^ groupSizes
dce33f8bb806 intitial checkin ca parents: diff changeset	1024	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1025
dce33f8bb806 intitial checkin ca parents: diff changeset	1026	groupSizes:aGroupSizes
dce33f8bb806 intitial checkin ca parents: diff changeset	1027	"sets collection of group sizes
dce33f8bb806 intitial checkin ca parents: diff changeset	1028	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1029	aGroupSizes = groupSizes ifFalse:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1030	groupSizes := aGroupSizes copy.
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1031	self mustRearrange.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1032	].
dce33f8bb806 intitial checkin ca parents: diff changeset	1033	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1034
dce33f8bb806 intitial checkin ca parents: diff changeset	1035	labelAt:stringOrNumber
dce33f8bb806 intitial checkin ca parents: diff changeset	1036	"gets the label of an item or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	1037	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1038	^ self itemAt:stringOrNumber do:[:el\| el label ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1039	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1040
dce33f8bb806 intitial checkin ca parents: diff changeset	1041	labelAt:stringOrNumber put:aLabel
dce33f8bb806 intitial checkin ca parents: diff changeset	1042	"sets the label of an item
dce33f8bb806 intitial checkin ca parents: diff changeset	1043	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1044	self itemAt:stringOrNumber do:[:el\| el label:aLabel ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1045	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1046
dce33f8bb806 intitial checkin ca parents: diff changeset	1047	labels
dce33f8bb806 intitial checkin ca parents: diff changeset	1048	"returns a collection of labels's or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	1049	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1050	^ self collect:[:anItem\| anItem label ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1051
dce33f8bb806 intitial checkin ca parents: diff changeset	1052	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1053
dce33f8bb806 intitial checkin ca parents: diff changeset	1054	labels:labels
dce33f8bb806 intitial checkin ca parents: diff changeset	1055	"define labels for each item
dce33f8bb806 intitial checkin ca parents: diff changeset	1056	"
2118 89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	1057	\|size\|
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	1058
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1059	self disabledRedrawDo:[
2118 89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	1060	self removeAll.
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	1061	size := labels size.
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	1062
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	1063	size > 0 ifTrue:[
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	1064	items := OrderedCollection new:size.
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	1065	labels do:[:aLabel\| items add:(Item in:self label:aLabel) ]
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	1066	]
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	1067	].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1068	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1069
1999 56a97236e72d * empty log message * Claus Gittinger <cg@exept.de> parents: 1998 diff changeset	1070	menuPerformer:anObject
56a97236e72d * empty log message * Claus Gittinger <cg@exept.de> parents: 1998 diff changeset	1071	"set the menu-receiver. Thats the one who gets the messages ( both from myself and
56a97236e72d * empty log message * Claus Gittinger <cg@exept.de> parents: 1998 diff changeset	1072	from all submenus no specific receiver is defined ).
56a97236e72d * empty log message * Claus Gittinger <cg@exept.de> parents: 1998 diff changeset	1073	"
56a97236e72d * empty log message * Claus Gittinger <cg@exept.de> parents: 1998 diff changeset	1074	^ self receiver:anObject
56a97236e72d * empty log message * Claus Gittinger <cg@exept.de> parents: 1998 diff changeset	1075	!
56a97236e72d * empty log message * Claus Gittinger <cg@exept.de> parents: 1998 diff changeset	1076
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1077	nameKeyAt:stringOrNumber
dce33f8bb806 intitial checkin ca parents: diff changeset	1078	"gets the nameKey of an item or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	1079	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1080	^ self itemAt:stringOrNumber do:[:el\| el nameKey ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1081	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1082
dce33f8bb806 intitial checkin ca parents: diff changeset	1083	nameKeyAt:stringOrNumber put:aNameKey
dce33f8bb806 intitial checkin ca parents: diff changeset	1084	"sets the nameKey of an item
dce33f8bb806 intitial checkin ca parents: diff changeset	1085	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1086	self itemAt:stringOrNumber do:[:el\| el nameKey:aNameKey ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1087	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1088
dce33f8bb806 intitial checkin ca parents: diff changeset	1089	nameKeys
dce33f8bb806 intitial checkin ca parents: diff changeset	1090	"returns a collection of nameKeys's or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	1091	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1092	^ self collect:[:anItem\| anItem nameKey ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1093	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1094
dce33f8bb806 intitial checkin ca parents: diff changeset	1095	nameKeys:something
dce33f8bb806 intitial checkin ca parents: diff changeset	1096	"define nameKeys for each item
dce33f8bb806 intitial checkin ca parents: diff changeset	1097	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1098	self onEachPerform:#nameKey: withArgList:something
dce33f8bb806 intitial checkin ca parents: diff changeset	1099	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1100
dce33f8bb806 intitial checkin ca parents: diff changeset	1101	numberOfItems
dce33f8bb806 intitial checkin ca parents: diff changeset	1102	"gets number of items
dce33f8bb806 intitial checkin ca parents: diff changeset	1103	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1104	^ items size
dce33f8bb806 intitial checkin ca parents: diff changeset	1105	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1106
dce33f8bb806 intitial checkin ca parents: diff changeset	1107	receiver
dce33f8bb806 intitial checkin ca parents: diff changeset	1108	"get the menu-receiver. Thats the one who gets the messages ( both from myself and
dce33f8bb806 intitial checkin ca parents: diff changeset	1109	from all submenus no specific receiver is defined ).
dce33f8bb806 intitial checkin ca parents: diff changeset	1110	"
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	1111	(receiver isNil and:[superMenu notNil]) ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1112	^ superMenu receiver
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1113	].
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	1114	^ receiver
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1115	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1116
dce33f8bb806 intitial checkin ca parents: diff changeset	1117	receiver:anObject
dce33f8bb806 intitial checkin ca parents: diff changeset	1118	"set the menu-receiver. Thats the one who gets the messages ( both from myself and
dce33f8bb806 intitial checkin ca parents: diff changeset	1119	from all submenus no specific receiver is defined ).
dce33f8bb806 intitial checkin ca parents: diff changeset	1120	"
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	1121	receiver := anObject
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1122	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1123
dce33f8bb806 intitial checkin ca parents: diff changeset	1124	shortcutKeyAt:stringOrNumber
dce33f8bb806 intitial checkin ca parents: diff changeset	1125	"gets the shortCutKey of an item or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	1126	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1127	^ self itemAt:stringOrNumber do:[:el\| el shortcutKey ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1128	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1129
dce33f8bb806 intitial checkin ca parents: diff changeset	1130	shortcutKeyAt:stringOrNumber put:aKey
dce33f8bb806 intitial checkin ca parents: diff changeset	1131	"sets the shortCutKey of an item
dce33f8bb806 intitial checkin ca parents: diff changeset	1132	"
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	1133	self itemAt:stringOrNumber do:[:el\| el shortcutKey:aKey ]
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	1134	!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1135
dce33f8bb806 intitial checkin ca parents: diff changeset	1136	shortcutKeys
dce33f8bb806 intitial checkin ca parents: diff changeset	1137	"returns a collection of shortcutKey's or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	1138	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1139	^ self collect:[:anItem\| anItem shortcutKey ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1140
dce33f8bb806 intitial checkin ca parents: diff changeset	1141	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1142
dce33f8bb806 intitial checkin ca parents: diff changeset	1143	shortcutKeys:something
dce33f8bb806 intitial checkin ca parents: diff changeset	1144	"define shortcutKey's for each item
dce33f8bb806 intitial checkin ca parents: diff changeset	1145	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1146	self onEachPerform:#shortcutKey: withArgList:something
dce33f8bb806 intitial checkin ca parents: diff changeset	1147	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1148
dce33f8bb806 intitial checkin ca parents: diff changeset	1149	valueAt:stringOrNumber
dce33f8bb806 intitial checkin ca parents: diff changeset	1150	"gets value of an item; a block, valueHolder, ...
dce33f8bb806 intitial checkin ca parents: diff changeset	1151	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1152	^ self itemAt:stringOrNumber do:[:el\| el value ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1153
dce33f8bb806 intitial checkin ca parents: diff changeset	1154	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1155
dce33f8bb806 intitial checkin ca parents: diff changeset	1156	valueAt:stringOrNumber put:someThing
dce33f8bb806 intitial checkin ca parents: diff changeset	1157	"sets value of an item; a block, valueHolder, ...
dce33f8bb806 intitial checkin ca parents: diff changeset	1158	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1159	self itemAt:stringOrNumber do:[:el\| el value:someThing ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1160
dce33f8bb806 intitial checkin ca parents: diff changeset	1161
dce33f8bb806 intitial checkin ca parents: diff changeset	1162	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1163
dce33f8bb806 intitial checkin ca parents: diff changeset	1164	values:something
dce33f8bb806 intitial checkin ca parents: diff changeset	1165	"define values for each item
dce33f8bb806 intitial checkin ca parents: diff changeset	1166	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1167	self onEachPerform:#value: withArgList:something
dce33f8bb806 intitial checkin ca parents: diff changeset	1168	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	1169
1679 af40842718f6 when accepting, and the application does not respond to that Claus Gittinger <cg@exept.de> parents: 1670 diff changeset	1170	!MenuPanel methodsFor:'accessing-behavior'!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1171
dce33f8bb806 intitial checkin ca parents: diff changeset	1172	disableAll
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1173	"disable all items; not the menu in case of enabled
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1174	"
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1175	self do:[:anItem\| anItem enabled:false]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1176	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1177
dce33f8bb806 intitial checkin ca parents: diff changeset	1178	disableAll:collectionOfIndicesOrNames
dce33f8bb806 intitial checkin ca parents: diff changeset	1179	"disable an collection of items
dce33f8bb806 intitial checkin ca parents: diff changeset	1180	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1181	collectionOfIndicesOrNames do:[:entry\| self enabledAt:entry put:false ].
dce33f8bb806 intitial checkin ca parents: diff changeset	1182
dce33f8bb806 intitial checkin ca parents: diff changeset	1183	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1184
dce33f8bb806 intitial checkin ca parents: diff changeset	1185	enableAll
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1186	"enable all items; not the menu in case of disabled
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1187	"
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1188	self do:[:anItem\| anItem enabled:true]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1189	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1190
dce33f8bb806 intitial checkin ca parents: diff changeset	1191	enableAll:collectionOfIndicesOrNames
dce33f8bb806 intitial checkin ca parents: diff changeset	1192	"enable an collection of items
dce33f8bb806 intitial checkin ca parents: diff changeset	1193	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1194	collectionOfIndicesOrNames do:[:entry\| self enabledAt:entry put:true ].
dce33f8bb806 intitial checkin ca parents: diff changeset	1195
dce33f8bb806 intitial checkin ca parents: diff changeset	1196	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1197
dce33f8bb806 intitial checkin ca parents: diff changeset	1198	enabled
dce33f8bb806 intitial checkin ca parents: diff changeset	1199	"returns enabled state
dce33f8bb806 intitial checkin ca parents: diff changeset	1200	"
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1201	^ enabled
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1202	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1203
dce33f8bb806 intitial checkin ca parents: diff changeset	1204	enabled:aState
dce33f8bb806 intitial checkin ca parents: diff changeset	1205	"change enabled state of menu
dce33f8bb806 intitial checkin ca parents: diff changeset	1206	"
545 d01d14358b07 * empty log message * Claus Gittinger <cg@exept.de> parents: 524 diff changeset	1207	\|state\|
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1208
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1209	state := aState ? true.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1210
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	1211	enabled ~~ state ifTrue:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	1212	enabled := state.
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	1213	self invalidate.
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1214	].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1215	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1216
dce33f8bb806 intitial checkin ca parents: diff changeset	1217	enabledAt:stringOrNumber
dce33f8bb806 intitial checkin ca parents: diff changeset	1218	"gets the enabled state of an item or false
dce33f8bb806 intitial checkin ca parents: diff changeset	1219	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1220	^ self itemAt:stringOrNumber do:[:el\| el enabled ] ifAbsent:false
dce33f8bb806 intitial checkin ca parents: diff changeset	1221	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1222
dce33f8bb806 intitial checkin ca parents: diff changeset	1223	enabledAt:stringOrNumber put:aState
dce33f8bb806 intitial checkin ca parents: diff changeset	1224	"sets the enabled state of an item
dce33f8bb806 intitial checkin ca parents: diff changeset	1225	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1226	self itemAt:stringOrNumber do:[:el\| el enabled:aState ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1227	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1228
dce33f8bb806 intitial checkin ca parents: diff changeset	1229	isEnabled:stringOrNumber
dce33f8bb806 intitial checkin ca parents: diff changeset	1230	"gets the enabled state of an item or false
dce33f8bb806 intitial checkin ca parents: diff changeset	1231	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1232	^ self enabledAt:stringOrNumber
dce33f8bb806 intitial checkin ca parents: diff changeset	1233	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	1234
1679 af40842718f6 when accepting, and the application does not respond to that Claus Gittinger <cg@exept.de> parents: 1670 diff changeset	1235	!MenuPanel methodsFor:'accessing-channels'!
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1236
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1237	enableChannel
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1238	"gets a enable channel or nil
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1239	"
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1240	^ enableChannel
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1241	!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1242
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1243	enableChannel:aValueHolder
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1244	"set my enableChannel
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1245	"
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1246	enableChannel notNil ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1247	enableChannel removeDependent:self
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1248	].
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1249
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1250	(enableChannel := aValueHolder) notNil ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1251	enableChannel addDependent:self.
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1252	].
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1253	self enabled:(enableChannel value).
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1254	!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1255
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1256	menuHolder
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1257	"gets a menu holder or nil
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1258	"
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1259	^ menuHolder
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1260	!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1261
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1262	menuHolder:aValueHolder
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1263	"set my menuHolder
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1264	"
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1265	menuHolder notNil ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1266	menuHolder removeDependent:self
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1267	].
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1268
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1269	(menuHolder := aValueHolder) notNil ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1270	menuHolder addDependent:self.
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1271	].
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	1272	self menu:(menuHolder value)
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1273	! !
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1274
1679 af40842718f6 when accepting, and the application does not respond to that Claus Gittinger <cg@exept.de> parents: 1670 diff changeset	1275	!MenuPanel methodsFor:'accessing-color & font'!
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1276
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1277	activeBackgroundColor
a6157b083830 support of different styles ca parents: 608 diff changeset	1278	"get the background drawing color used to highlight selection
a6157b083830 support of different styles ca parents: 608 diff changeset	1279	"
a6157b083830 support of different styles ca parents: 608 diff changeset	1280	^ activeBgColor
a6157b083830 support of different styles ca parents: 608 diff changeset	1281	!
a6157b083830 support of different styles ca parents: 608 diff changeset	1282
a6157b083830 support of different styles ca parents: 608 diff changeset	1283	activeForegroundColor
a6157b083830 support of different styles ca parents: 608 diff changeset	1284	"get the foreground color used to highlight selections
a6157b083830 support of different styles ca parents: 608 diff changeset	1285	"
a6157b083830 support of different styles ca parents: 608 diff changeset	1286	^ activeFgColor
a6157b083830 support of different styles ca parents: 608 diff changeset	1287	!
a6157b083830 support of different styles ca parents: 608 diff changeset	1288
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1289	backgroundColor
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1290	"return the background color
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1291	"
502 dedc1b29b6ac support of arguments ca parents: 498 diff changeset	1292	^ super viewBackground
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1293	!
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1294
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1295	backgroundColor:aColor
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1296	"set the background drawing color. You should not use this method;
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1297	instead leave the value as defined in the styleSheet.
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1298	"
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1299	super viewBackground ~~ aColor ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1300	super viewBackground:aColor.
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1301	shown ifTrue:[
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1302	self invalidate "/ RepairNow:true
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1303	]
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1304	]
a6157b083830 support of different styles ca parents: 608 diff changeset	1305
911 6b1ad8b039c5 no, repairNow should not be needed here Claus Gittinger <cg@exept.de> parents: 910 diff changeset	1306	"Modified: / 6.6.1998 / 19:50:06 / cg"
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1307	!
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1308
727 3ba54333342a button style from style sheet tz parents: 723 diff changeset	1309	buttonActiveBackgroundColor
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1310	"get the background drawing color used to highlight button selection
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1311	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1312	^ ButtonActiveBackgroundColor
727 3ba54333342a button style from style sheet tz parents: 723 diff changeset	1313	!
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1314
730 9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1315	buttonEdgeStyle
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1316	"get the button edge style
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1317	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1318	^ ButtonEdgeStyle
730 9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1319	!
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1320
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1321	buttonEnteredBackgroundColor
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1322	"get the background drawing color used to highlight entered button items
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1323	"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1324	^ buttonEnteredBgColor
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1325
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1326	"Created: / 20.8.1998 / 13:53:37 / cg"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1327	!
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1328
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1329	buttonEnteredLevel
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1330	"get the 3D-level used to highlight entered button items
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1331	"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1332	^ ButtonEnteredLevel
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1333
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1334	"Created: / 20.8.1998 / 13:53:46 / cg"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1335	"Modified: / 20.8.1998 / 15:49:32 / cg"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1336	!
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	1337
730 9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1338	buttonHalfLightColor
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1339	"get the background drawing color used to half light button frame
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1340	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1341	^ buttonHalfLightColor
730 9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1342	!
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1343
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1344	buttonHalfShadowColor
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1345	"get the background drawing color used to half shadow button frame
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1346	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1347	^ buttonHalfShadowColor
727 3ba54333342a button style from style sheet tz parents: 723 diff changeset	1348	!
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1349
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1350	buttonLightColor
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1351	"get the background drawing color used to light button frame
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1352	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1353	^ buttonLightColor
727 3ba54333342a button style from style sheet tz parents: 723 diff changeset	1354	!
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1355
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1356	buttonPassiveBackgroundColor
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1357	"get the background drawing color used for button
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1358	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1359	^ ButtonPassiveBackgroundColor
727 3ba54333342a button style from style sheet tz parents: 723 diff changeset	1360	!
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1361
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1362	buttonShadowColor
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1363	"get the background drawing color used to shadow button frame
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1364	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1365	^ buttonShadowColor
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1366	!
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1367
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1368	disabledEtchedForegroundColor
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1369	"return the color used for etching disabled items.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1370	If nil, no 3D effect is drawn.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1371	"
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1372	^ disabledEtchedFgColor
727 3ba54333342a button style from style sheet tz parents: 723 diff changeset	1373	!
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1374
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1375	disabledForegroundColor
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1376	"return the foreground color used by disabled items
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1377	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1378	^ disabledFgColor
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1379	!
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1380
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1381	font:aFont
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1382	"set the font
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1383	"
829 c86ed87da63b bug fix: ca parents: 828 diff changeset	1384	(aFont notNil and:[aFont ~= font]) ifTrue:[
1478 38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	1385	super font:(aFont onDevice:device).
38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	1386
38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	1387	superMenu notNil ifTrue:[
38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	1388	self extent:(self preferredExtent)
38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	1389	].
38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	1390	self mustRearrange.
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1391	]
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1392	!
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1393
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1394	foregroundColor
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1395	"return the passive foreground color
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1396	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1397	^ fgColor
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1398	!
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1399
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1400	foregroundColor:aColor
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1401	"set the foregroundColor drawing color. You should not use this method;
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1402	instead leave the value as defined in the styleSheet.
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1403	"
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1404	fgColor ~~ aColor ifTrue:[
1478 38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	1405	fgColor := aColor onDevice:device.
38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	1406	shown ifTrue:[
38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	1407	self invalidate "/ RepairNow:true
38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	1408	]
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1409	]
a6157b083830 support of different styles ca parents: 608 diff changeset	1410
911 6b1ad8b039c5 no, repairNow should not be needed here Claus Gittinger <cg@exept.de> parents: 910 diff changeset	1411	"Modified: / 6.6.1998 / 19:50:46 / cg"
580 249f6cfc5bb2 checkin from browser Claus Gittinger <cg@exept.de> parents: 571 diff changeset	1412	!
249f6cfc5bb2 checkin from browser Claus Gittinger <cg@exept.de> parents: 571 diff changeset	1413
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1414	maxAbsoluteButtonLevel
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1415	"returns the maximum absolute button level; used to compute the preferred
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1416	extent of a button
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1417	"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1418	\|level\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1419
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1420	level := (ButtonActiveLevel abs) max:(ButtonEnteredLevel abs).
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1421	^ level max:(ButtonPassiveLevel abs)
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1422	!
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1423
730 9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1424	selectionFrameBrightColor
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1425	"get the selection frame bright color
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1426	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1427	^ selectionFrameBrightColor
730 9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1428	!
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1429
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1430	selectionFrameDarkColor
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1431	"get the selection frame dark color
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1432	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1433	^ selectionFrameDarkColor
730 9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1434	!
9e45051a4fbd better button draw routine + style sheet support tz parents: 729 diff changeset	1435
1727 a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	1436	setFont:aFont
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	1437	"set the font derived from item; if unchanged nil is returned otherwise the old font
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	1438	"
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	1439	\|currentFont\|
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	1440
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	1441	(aFont notNil and:[aFont ~= font]) ifTrue:[
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	1442	currentFont := font.
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	1443	super font:aFont.
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	1444	].
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	1445	^ currentFont
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1446	! !
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1447
1679 af40842718f6 when accepting, and the application does not respond to that Claus Gittinger <cg@exept.de> parents: 1670 diff changeset	1448	!MenuPanel methodsFor:'accessing-dimensions'!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1449
dce33f8bb806 intitial checkin ca parents: diff changeset	1450	height
dce33f8bb806 intitial checkin ca parents: diff changeset	1451	"default height
dce33f8bb806 intitial checkin ca parents: diff changeset	1452	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1453	(explicitExtent ~~ true) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1454	^ self preferredExtent y
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1455	].
dce33f8bb806 intitial checkin ca parents: diff changeset	1456	^ super height
dce33f8bb806 intitial checkin ca parents: diff changeset	1457	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1458
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1459	maxExtent
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1460	"CLAUS: returns the maximum extent
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1461	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1462	\|x y\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1463
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1464	device isNil ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1465	superMenu notNil ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1466	^ superMenu maxExtent
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1467	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1468	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1469	y := device usableHeight - 2.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1470	x := device usableWidth - 2.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1471	^ x@y
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1472	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1473
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1474	preferredExtent
dce33f8bb806 intitial checkin ca parents: diff changeset	1475	"compute and returns my preferred extent
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1476	"
2024 1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1477	\|maxExtent usedExtent w\|
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1478
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1479	preferredExtent notNil ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1480	^ preferredExtent
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1481	].
2024 1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1482	maxExtent := self maxExtent.
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1483	usedExtent := self preferredExtentOfItems.
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1484
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1485	superView isNil ifTrue:[
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1486	"/ is standalone
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1487	w := self menuAdornmentAt:#Width.
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1488
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1489	w notNil ifTrue:[
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1490	usedExtent x < w ifTrue:[
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1491	usedExtent := w @ usedExtent y.
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1492	]
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1493	]
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1494	].
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1495
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1496	^ usedExtent min:maxExtent
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1497
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1498	"Modified: / 10.10.2001 / 14:57:25 / cg"
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1499	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1500
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1501	preferredExtentOfItems
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	1502	"compute and returns my preferred extent including all items
1723 f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	1503	!!!!!! changes have influence on method #rearrangeItems !!!!!!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1504	"
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	1505	\|hasMenu shCtKey extent showAcc sck
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1506	x "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1507	y "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1508	size "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1509	buttonInset "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1510	labelInset "{ Class:SmallInteger }"
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	1511	\|
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1512
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1513	(size := items size) == 0 ifTrue:[
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1514	^ 32 @ 32
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1515	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1516	buttonInset := 2 * (DefaultButtonItemSpace abs).
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1517
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1518	self isPopUpView ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1519	labelInset := 2 * (DefaultEnteredLevel abs).
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1520	] ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1521	labelInset := 0.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1522	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1523
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1524	x := 0.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1525	y := 0.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1526
dce33f8bb806 intitial checkin ca parents: diff changeset	1527	self verticalLayout ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1528	"/ HORIZONTAL LAYOUT
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1529
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1530	items keysAndValuesDo:[:key :el\| \|eX eY\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1531	extent := el preferredExtent.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1532
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1533	"/ check for visibility (extent x ~~ 0)
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1534	(eX := extent x) ~~ 0 ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1535	eY := extent y.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1536
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1537	el isButton ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1538	eX := eX + buttonInset.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1539	eY := eY + buttonInset.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1540	] ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1541	eX := eX + labelInset.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1542	eY := eY + labelInset.
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1543	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1544	key ~~ size ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1545	(self hasGroupDividerAt:key) ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1546	x := x + groupDividerSize
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1547	] ifFalse:[
1723 f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	1548	el isLabeledItem ifTrue:[
f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	1549	x := x + itemSpace
f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	1550	]
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1551	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1552	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1553	x := eX + x.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1554	y := eY max:y.
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1555	]
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1556	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1557	] ifTrue:[
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1558	hasMenu := false.
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1559	shCtKey := 0.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1560	showAcc := MenuView showAcceleratorKeys == true.
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1561	y := x.
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1562	x := 0.
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1563
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1564	items keysAndValuesDo:[:key :el\| \|eX eY\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1565	extent := el preferredExtent.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1566
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1567	"/ check for visibility (extent x ~~ 0)
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1568	(eX := extent x) ~~ 0 ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1569	eY := extent y.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1570
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1571	el isButton ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1572	eX := eX + buttonInset.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1573	eY := eY + buttonInset.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1574	] ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1575	eX := eX + labelInset.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1576	eY := eY + labelInset.
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1577	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1578	hasMenu ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1579	hasMenu := el hasSubmenu
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1580	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1581	(showAcc and:[(sck := el shortcutKeyAsString) notNil]) ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1582	shCtKey := shCtKey max:(sck widthOn:self)
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1583	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1584	key ~~ size ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1585	(self hasGroupDividerAt:key) ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1586	y := y + groupDividerSize
1723 f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	1587	"/ ] ifFalse:[
f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	1588	"/ y := y + itemSpace
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1589	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1590	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1591	y := eY + y.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1592	x := eX max:x.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1593	].
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1594	].
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1595
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1596	(hasMenu or:[shCtKey ~~ 0]) ifTrue:[
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1597	shortKeyInset := x + Item labelRightOffset.
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1598	x := shortKeyInset + shCtKey + self subMenuIndicationWidth.
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1599
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1600	(shCtKey ~~ 0 and:[hasMenu]) ifTrue:[
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1601	x := x + ShortcutKeyOffset
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1602	]
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	1603	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1604	"/ to have a small inset
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1605	y := y + 1.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1606	"/ x := x + 1.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1607	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1608	x := x + margin + margin.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1609	y := y + margin + margin.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1610
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1611	^ x @ y
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1612	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1613
2024 1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1614	preferredWidth:aWidth
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1615	self menuAdornmentAt:#Width put:aWidth.
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1616
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1617	"Created: / 10.10.2001 / 14:56:39 / cg"
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1618	!
1214769c0441 + #preferredWidth: Claus Gittinger <cg@exept.de> parents: 2020 diff changeset	1619
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1620	shortKeyInset
dce33f8bb806 intitial checkin ca parents: diff changeset	1621	"left inset of shortcutKey
dce33f8bb806 intitial checkin ca parents: diff changeset	1622	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1623	^ shortKeyInset
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1624	!
a6157b083830 support of different styles ca parents: 608 diff changeset	1625
a6157b083830 support of different styles ca parents: 608 diff changeset	1626	subMenuIndicationWidth
a6157b083830 support of different styles ca parents: 608 diff changeset	1627	^ RightArrowForm width
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1628	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	1629
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1630	!MenuPanel methodsFor:'accessing-interactors'!
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1631
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1632	iconIndicationDisabledOff
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1633	iconIndicationDisabledOff isNil ifTrue:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1634	superMenu notNil ifTrue:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1635	iconIndicationDisabledOff := superMenu iconIndicationDisabledOff
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1636	] ifFalse:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1637	iconIndicationDisabledOff := self registerImageOnDevice:(self class iconIndicationDisabledOff)
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1638	].
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1639	].
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1640	^ iconIndicationDisabledOff
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1641	!
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1642
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1643	iconIndicationDisabledOn
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1644	iconIndicationDisabledOn isNil ifTrue:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1645	superMenu notNil ifTrue:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1646	iconIndicationDisabledOn := superMenu iconIndicationDisabledOn
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1647	] ifFalse:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1648	iconIndicationDisabledOn := self registerImageOnDevice:(self class iconIndicationDisabledOn)
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1649	].
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1650	].
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1651	^ iconIndicationDisabledOn
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1652	!
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1653
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1654	iconIndicationOff
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1655	iconIndicationOff isNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1656	superMenu notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1657	iconIndicationOff := superMenu iconIndicationOff
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1658	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1659	iconIndicationOff := self registerImageOnDevice:(self class iconIndicationOff)
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1660	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1661	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1662	^ iconIndicationOff
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1663	!
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1664
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1665	iconIndicationOn
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1666	iconIndicationOn isNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1667	superMenu notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1668	iconIndicationOn := superMenu iconIndicationOn
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1669	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1670	iconIndicationOn := self registerImageOnDevice:(self class iconIndicationOn)
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1671	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1672	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1673	^ iconIndicationOn
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1674	!
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1675
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1676	iconRadioGroupDisabledOff
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1677	iconRadioGroupDisabledOff isNil ifTrue:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1678	superMenu notNil ifTrue:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1679	iconRadioGroupDisabledOff := superMenu iconRadioGroupDisabledOff
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1680	] ifFalse:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1681	iconRadioGroupDisabledOff := self registerImageOnDevice:(self class iconRadioGroupDisabledOff)
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1682	].
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1683	].
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1684	^ iconRadioGroupDisabledOff
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1685	!
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1686
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1687	iconRadioGroupDisabledOn
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1688	iconRadioGroupDisabledOn isNil ifTrue:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1689	superMenu notNil ifTrue:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1690	iconRadioGroupDisabledOn := superMenu iconRadioGroupDisabledOn
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1691	] ifFalse:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1692	iconRadioGroupDisabledOn := self registerImageOnDevice:(self class iconRadioGroupDisabledOn)
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1693	].
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1694	].
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1695	^ iconRadioGroupDisabledOn
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1696	!
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	1697
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1698	iconRadioGroupOff
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1699	iconRadioGroupOff isNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1700	superMenu notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1701	iconRadioGroupOff := superMenu iconRadioGroupOff
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1702	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1703	iconRadioGroupOff := self registerImageOnDevice:(self class iconRadioGroupOff)
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1704	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1705	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1706	^ iconRadioGroupOff
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1707	!
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1708
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1709	iconRadioGroupOn
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1710	iconRadioGroupOn isNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1711	superMenu notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1712	iconRadioGroupOn := superMenu iconRadioGroupOn
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1713	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1714	iconRadioGroupOn := self registerImageOnDevice:(self class iconRadioGroupOn)
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1715	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1716	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1717	^ iconRadioGroupOn
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1718	! !
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	1719
1679 af40842718f6 when accepting, and the application does not respond to that Claus Gittinger <cg@exept.de> parents: 1670 diff changeset	1720	!MenuPanel methodsFor:'accessing-items'!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1721
dce33f8bb806 intitial checkin ca parents: diff changeset	1722	itemAt:stringOrNumber
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1723	"returns item assigned to an index, nameKey, textLabel or value if symbol.
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1724	If no item match nil is returned.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1725	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1726	\|idx\|
dce33f8bb806 intitial checkin ca parents: diff changeset	1727
dce33f8bb806 intitial checkin ca parents: diff changeset	1728	idx := self indexOf:stringOrNumber.
dce33f8bb806 intitial checkin ca parents: diff changeset	1729	(idx > 0 and:[idx <= items size]) ifTrue:[ ^ items at:idx ].
dce33f8bb806 intitial checkin ca parents: diff changeset	1730	^ nil
dce33f8bb806 intitial checkin ca parents: diff changeset	1731
dce33f8bb806 intitial checkin ca parents: diff changeset	1732	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1733
dce33f8bb806 intitial checkin ca parents: diff changeset	1734	itemAt:stringOrNumber do:aOneArgBlock
dce33f8bb806 intitial checkin ca parents: diff changeset	1735	"evaluate teh block for an item and return the result from the block. In case that
dce33f8bb806 intitial checkin ca parents: diff changeset	1736	the item not exists nil is returned
dce33f8bb806 intitial checkin ca parents: diff changeset	1737	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1738	^ self itemAt:stringOrNumber do:aOneArgBlock ifAbsent:nil
dce33f8bb806 intitial checkin ca parents: diff changeset	1739	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1740
dce33f8bb806 intitial checkin ca parents: diff changeset	1741	itemAt:stringOrNumber do:aOneArgBlock ifAbsent:exceptionBlock
dce33f8bb806 intitial checkin ca parents: diff changeset	1742	"evaluate teh block for an item and return the result from the block. In case that
dce33f8bb806 intitial checkin ca parents: diff changeset	1743	the item not exists the result of the exception block is returned (no arguments).
dce33f8bb806 intitial checkin ca parents: diff changeset	1744	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1745	\|item\|
dce33f8bb806 intitial checkin ca parents: diff changeset	1746
dce33f8bb806 intitial checkin ca parents: diff changeset	1747	item := self itemAt:stringOrNumber.
dce33f8bb806 intitial checkin ca parents: diff changeset	1748	item notNil ifTrue:[ ^ aOneArgBlock value:item ].
dce33f8bb806 intitial checkin ca parents: diff changeset	1749	^ exceptionBlock value
706 d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	1750	!
d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	1751
d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	1752	itemAtIndex:anIndex
d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	1753	"returns item at an index or nil
d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	1754	"
d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	1755	^ items notNil ifTrue:[items at:anIndex ifAbsent:nil] ifFalse:[nil]
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	1756	!
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	1757
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	1758	items
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	1759	"returns list of items or nil
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	1760	"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	1761	^ items
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1762	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	1763
1679 af40842718f6 when accepting, and the application does not respond to that Claus Gittinger <cg@exept.de> parents: 1670 diff changeset	1764	!MenuPanel methodsFor:'accessing-look'!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1765
727 3ba54333342a button style from style sheet tz parents: 723 diff changeset	1766	buttonActiveLevel
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1767	"get the button active level
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1768	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1769	^ ButtonActiveLevel
727 3ba54333342a button style from style sheet tz parents: 723 diff changeset	1770	!
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1771
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1772	buttonPassiveLevel
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1773	"get the button passive level
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1774	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	1775	^ ButtonPassiveLevel
727 3ba54333342a button style from style sheet tz parents: 723 diff changeset	1776	!
3ba54333342a button style from style sheet tz parents: 723 diff changeset	1777
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1778	fitFirstPanel
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1779	"gets true if the first panel in the menu hierarchy must be fit
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1780	to the extent of its superView
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1781
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1782	NOT SUPPORTED
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1783	"
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1784	^ fitFirstPanel
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1785	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1786
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1787	fitFirstPanel:aState
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1788	"sets true if the first panel in the menu hierarchy must be fit
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1789	to the extent of its superView
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1790
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1791	NOT SUPPORTED
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1792	"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	1793	fitFirstPanel := aState.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1794	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1795
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1796	groupDividerSize
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1797	"get the size of the group dividers
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1798	"
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1799	^ groupDividerSize
a6157b083830 support of different styles ca parents: 608 diff changeset	1800
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1801	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1802
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1803	groupDividerSize:aSize
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1804	"set the size of the group dividers. You should not use this
a6157b083830 support of different styles ca parents: 608 diff changeset	1805	method; instead leave the value as defined in the styleSheet.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1806	"
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1807	aSize ~~ groupDividerSize ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1808	groupDividerSize := aSize.
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1809	self mustRearrange.
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1810	].
a6157b083830 support of different styles ca parents: 608 diff changeset	1811
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1812	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1813
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1814	itemSpace
a6157b083830 support of different styles ca parents: 608 diff changeset	1815	"get the space space between to items
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1816	"
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1817	^ itemSpace
a6157b083830 support of different styles ca parents: 608 diff changeset	1818
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1819	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1820
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1821	itemSpace:aSize
a6157b083830 support of different styles ca parents: 608 diff changeset	1822	"set the horizontal space between to items. You should not use this
a6157b083830 support of different styles ca parents: 608 diff changeset	1823	method; instead leave the value as defined in the styleSheet.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1824	"
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1825	aSize ~~ itemSpace ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1826	itemSpace := aSize.
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1827	self mustRearrange
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1828	].
a6157b083830 support of different styles ca parents: 608 diff changeset	1829
a6157b083830 support of different styles ca parents: 608 diff changeset	1830	!
a6157b083830 support of different styles ca parents: 608 diff changeset	1831
1093 7cb44303b016 margin fixes Claus Gittinger <cg@exept.de> parents: 1090 diff changeset	1832	level:anInt
2003 732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	1833	anInt ~~ level ifTrue:[
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	1834	super level:anInt.
2052 61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	1835	self mustRearrange
2003 732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	1836	]
2052 61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	1837
61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	1838	"Modified: / 15.11.2001 / 17:42:07 / cg"
1093 7cb44303b016 margin fixes Claus Gittinger <cg@exept.de> parents: 1090 diff changeset	1839	!
7cb44303b016 margin fixes Claus Gittinger <cg@exept.de> parents: 1090 diff changeset	1840
616 a6157b083830 support of different styles ca parents: 608 diff changeset	1841	rightArrow
a6157b083830 support of different styles ca parents: 608 diff changeset	1842	^ rightArrow
a6157b083830 support of different styles ca parents: 608 diff changeset	1843	!
a6157b083830 support of different styles ca parents: 608 diff changeset	1844
a6157b083830 support of different styles ca parents: 608 diff changeset	1845	rightArrowShadow
a6157b083830 support of different styles ca parents: 608 diff changeset	1846	^ rightArrowShadow
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1847	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1848
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1849	showGroupDivider
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1850	"get the enabled flag for showing groupDiveders
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1851	"
1222 8d58a1a93582 * empty log message * Claus Gittinger <cg@exept.de> parents: 1221 diff changeset	1852	^ (self menuAdornmentAt:#showGroupDivider)
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1853	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1854
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1855	showGroupDivider:aState
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1856	"set the enabled flag for showing groupDiveders
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1857	"
653 cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	1858	(self menuAdornmentAt:#showGroupDivider put:aState) ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1859	self mustRearrange.
653 cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	1860	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1861	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1862
dce33f8bb806 intitial checkin ca parents: diff changeset	1863	showSeparatingLines
dce33f8bb806 intitial checkin ca parents: diff changeset	1864	"gets true if drawing of separating lines is enabled.
dce33f8bb806 intitial checkin ca parents: diff changeset	1865	"
1222 8d58a1a93582 * empty log message * Claus Gittinger <cg@exept.de> parents: 1221 diff changeset	1866	^ (self menuAdornmentAt:#showSeparatingLines)
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1867	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1868
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	1869	showSeparatingLines:aState
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1870	"turn on/off drawing of separating lines.
dce33f8bb806 intitial checkin ca parents: diff changeset	1871	"
653 cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	1872	(self menuAdornmentAt:#showSeparatingLines put:aState) ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1873	self mustRearrange
653 cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	1874	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1875	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1876
dce33f8bb806 intitial checkin ca parents: diff changeset	1877	verticalLayout
dce33f8bb806 intitial checkin ca parents: diff changeset	1878	"get the layout: or vertical( true ) or horizontal( false )
dce33f8bb806 intitial checkin ca parents: diff changeset	1879	"
1824 ad38ecd8752d support horizontal or vertical layout for popup menus ca parents: 1819 diff changeset	1880	\|direction\|
ad38ecd8752d support horizontal or vertical layout for popup menus ca parents: 1819 diff changeset	1881
ad38ecd8752d support horizontal or vertical layout for popup menus ca parents: 1819 diff changeset	1882	direction := self menuAdornmentAt:#verticalLayout.
2079 0cd146d5c163 verticalLayout fix Claus Gittinger <cg@exept.de> parents: 2073 diff changeset	1883	direction notNil ifTrue:[^ direction].
0cd146d5c163 verticalLayout fix Claus Gittinger <cg@exept.de> parents: 2073 diff changeset	1884	self isPopUpView ifTrue:[^ true].
0cd146d5c163 verticalLayout fix Claus Gittinger <cg@exept.de> parents: 2073 diff changeset	1885	^ superMenu notNil
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1886	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1887
dce33f8bb806 intitial checkin ca parents: diff changeset	1888	verticalLayout:aState
dce33f8bb806 intitial checkin ca parents: diff changeset	1889	"set the layout: or vertical( true ) or horizontal( false )
dce33f8bb806 intitial checkin ca parents: diff changeset	1890	"
653 cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	1891	(self menuAdornmentAt:#verticalLayout put:aState) ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1892	self mustRearrange
653 cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	1893	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1894	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	1895
1679 af40842718f6 when accepting, and the application does not respond to that Claus Gittinger <cg@exept.de> parents: 1670 diff changeset	1896	!MenuPanel methodsFor:'accessing-submenu'!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1897
dce33f8bb806 intitial checkin ca parents: diff changeset	1898	subMenuAt:stringOrNumber
dce33f8bb806 intitial checkin ca parents: diff changeset	1899	"gets the submenu of an item or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	1900	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1901	^ self itemAt:stringOrNumber do:[:el\| el submenu ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1902	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1903
dce33f8bb806 intitial checkin ca parents: diff changeset	1904	subMenuAt:stringOrNumber put:aSubMenu
dce33f8bb806 intitial checkin ca parents: diff changeset	1905	"sets the submenu of an item
dce33f8bb806 intitial checkin ca parents: diff changeset	1906	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1907	self itemAt:stringOrNumber do:[:el\| el submenu:aSubMenu ]
dce33f8bb806 intitial checkin ca parents: diff changeset	1908
dce33f8bb806 intitial checkin ca parents: diff changeset	1909	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1910
dce33f8bb806 intitial checkin ca parents: diff changeset	1911	subMenuShown
dce33f8bb806 intitial checkin ca parents: diff changeset	1912	"return the currently visible submenu - or nil if there is none
dce33f8bb806 intitial checkin ca parents: diff changeset	1913	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1914	\|item\|
dce33f8bb806 intitial checkin ca parents: diff changeset	1915
dce33f8bb806 intitial checkin ca parents: diff changeset	1916	(item := self selection) notNil ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	1917	^ item submenu
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1918	].
dce33f8bb806 intitial checkin ca parents: diff changeset	1919	^ nil
dce33f8bb806 intitial checkin ca parents: diff changeset	1920	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	1921
1698 8d29156bab20 category rename Claus Gittinger <cg@exept.de> parents: 1697 diff changeset	1922	!MenuPanel methodsFor:'activation / deactivation'!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1923
1795 6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	1924	closeMenus
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	1925	"close all menus; operation is done; nothing accepted
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	1926	"
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	1927	self topMenu accept:nil.
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	1928	!
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	1929
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1930	hide
dce33f8bb806 intitial checkin ca parents: diff changeset	1931	"hide the view, leave its modal event loop
dce33f8bb806 intitial checkin ca parents: diff changeset	1932	"
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	1933
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1934	self selection:nil.
dce33f8bb806 intitial checkin ca parents: diff changeset	1935	self unmap.
dce33f8bb806 intitial checkin ca parents: diff changeset	1936
dce33f8bb806 intitial checkin ca parents: diff changeset	1937
dce33f8bb806 intitial checkin ca parents: diff changeset	1938	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1939
dce33f8bb806 intitial checkin ca parents: diff changeset	1940	show
1836 89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1941	"realize the view at its last position;
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1942	return the value of the selectedItem or nil, of none was selected
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1943	(unless the menu has already performed its action, by sending an appropriate message
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1944	to some performer)
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1945	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1946	^ self showAt:(self origin) resizing:true
dce33f8bb806 intitial checkin ca parents: diff changeset	1947
dce33f8bb806 intitial checkin ca parents: diff changeset	1948	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1949
dce33f8bb806 intitial checkin ca parents: diff changeset	1950	showAt:aPoint
1836 89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1951	"realize the view at aPoint.
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1952	return the value of the selectedItem or nil, of none was selected
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1953	(unless the menu has already performed its action, by sending an appropriate message
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1954	to some performer)
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1955	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1956	^ self showAt:aPoint resizing:true
dce33f8bb806 intitial checkin ca parents: diff changeset	1957
dce33f8bb806 intitial checkin ca parents: diff changeset	1958
dce33f8bb806 intitial checkin ca parents: diff changeset	1959	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1960
dce33f8bb806 intitial checkin ca parents: diff changeset	1961	showAt:aPoint resizing:aBoolean
984 87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1962	"realize the view at aPoint; return nil if no item was selected,
87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1963	or if I have already performed.
87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1964	Return the items value, otherwise.
87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1965	Notice, that this is returned back to the one who started this
87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1966	menu (i.e. the view or controller), which will perform the action
87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1967	if a non-nil is returned.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1968	"
1836 89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1969
1331 aae37cbfb30a fixed style handling to avoid bad resizing when popup-level/bw Claus Gittinger <cg@exept.de> parents: 1330 diff changeset	1970	self rearrangeItemsIfItemVisibilityChanged.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1971
dce33f8bb806 intitial checkin ca parents: diff changeset	1972	aBoolean ifTrue:[
1459 53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	1973	self fixSize.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1974	].
dce33f8bb806 intitial checkin ca parents: diff changeset	1975	self origin:aPoint.
1459 53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	1976	"/ self makeFullyVisible. -- done in realize
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1977	self openModal:[true]. "realize "
dce33f8bb806 intitial checkin ca parents: diff changeset	1978
984 87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1979	"/ if I have already performed,
87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1980	"/ return nil - to avoid items triggering twice.
87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1981
87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1982	(self topMenu menuAdornmentAt:#hasPerformed) == true ifTrue:[
1459 53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	1983	^ nil
984 87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1984	].
1836 89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1985
984 87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1986	^ self lastValueAccepted
87d36803b9d8 oops - menu items fired twice. Claus Gittinger <cg@exept.de> parents: 971 diff changeset	1987
1137 7df0b776e47a fixes for 2D styles (borderWidth) Claus Gittinger <cg@exept.de> parents: 1130 diff changeset	1988	"Modified: / 15.9.1998 / 12:50:23 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1989	!
dce33f8bb806 intitial checkin ca parents: diff changeset	1990
dce33f8bb806 intitial checkin ca parents: diff changeset	1991	showAtPointer
1836 89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1992	"realize the view at the current pointer position.
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1993	return the value of the selectedItem or nil, of none was selected
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1994	(unless the menu has already performed its action, by sending an appropriate message
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	1995	to some performer)
388 dce33f8bb806 intitial checkin ca parents: diff changeset	1996	"
dce33f8bb806 intitial checkin ca parents: diff changeset	1997	^ self showAt:(device pointerPosition) resizing:true
dce33f8bb806 intitial checkin ca parents: diff changeset	1998
dce33f8bb806 intitial checkin ca parents: diff changeset	1999
dce33f8bb806 intitial checkin ca parents: diff changeset	2000	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2001
dce33f8bb806 intitial checkin ca parents: diff changeset	2002	showCenteredIn:aView
dce33f8bb806 intitial checkin ca parents: diff changeset	2003	"make myself visible at the screen center.
1836 89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2004	return the value of the selectedItem or nil, of none was selected
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2005	(unless the menu has already performed its action, by sending an appropriate message
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2006	to some performer)
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2007	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2008	\|top\|
dce33f8bb806 intitial checkin ca parents: diff changeset	2009
dce33f8bb806 intitial checkin ca parents: diff changeset	2010	top := aView topView.
dce33f8bb806 intitial checkin ca parents: diff changeset	2011	top raise.
1137 7df0b776e47a fixes for 2D styles (borderWidth) Claus Gittinger <cg@exept.de> parents: 1130 diff changeset	2012	^ self showAt:(top origin + (aView originRelativeTo:top) + (aView extent // 2) - (self extent // 2))
7df0b776e47a fixes for 2D styles (borderWidth) Claus Gittinger <cg@exept.de> parents: 1130 diff changeset	2013
7df0b776e47a fixes for 2D styles (borderWidth) Claus Gittinger <cg@exept.de> parents: 1130 diff changeset	2014	"Modified: / 15.9.1998 / 12:45:50 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2015	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2016
dce33f8bb806 intitial checkin ca parents: diff changeset	2017	startUp
dce33f8bb806 intitial checkin ca parents: diff changeset	2018	"realize the menu at the current pointer position
1836 89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2019	return the value of the selectedItem or nil, of none was selected
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2020	(unless the menu has already performed its action, by sending an appropriate message
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2021	to some performer)
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2022	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2023	^ self showAtPointer
897 6bbc8c15ac0a added #startUpAt: (MenuView compatibility) Claus Gittinger <cg@exept.de> parents: 890 diff changeset	2024	!
6bbc8c15ac0a added #startUpAt: (MenuView compatibility) Claus Gittinger <cg@exept.de> parents: 890 diff changeset	2025
6bbc8c15ac0a added #startUpAt: (MenuView compatibility) Claus Gittinger <cg@exept.de> parents: 890 diff changeset	2026	startUpAt:aPoint
6bbc8c15ac0a added #startUpAt: (MenuView compatibility) Claus Gittinger <cg@exept.de> parents: 890 diff changeset	2027	"realize the menu at aPoint
1836 89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2028	return the value of the selectedItem or nil, of none was selected
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2029	(unless the menu has already performed its action, by sending an appropriate message
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2030	to some performer)
897 6bbc8c15ac0a added #startUpAt: (MenuView compatibility) Claus Gittinger <cg@exept.de> parents: 890 diff changeset	2031	"
6bbc8c15ac0a added #startUpAt: (MenuView compatibility) Claus Gittinger <cg@exept.de> parents: 890 diff changeset	2032	^ self showAt:aPoint
6bbc8c15ac0a added #startUpAt: (MenuView compatibility) Claus Gittinger <cg@exept.de> parents: 890 diff changeset	2033
6bbc8c15ac0a added #startUpAt: (MenuView compatibility) Claus Gittinger <cg@exept.de> parents: 890 diff changeset	2034	"Created: / 21.5.1998 / 14:15:57 / cg"
1750 f9e5700bd99a compatibility stuff Claus Gittinger <cg@exept.de> parents: 1737 diff changeset	2035	!
f9e5700bd99a compatibility stuff Claus Gittinger <cg@exept.de> parents: 1737 diff changeset	2036
f9e5700bd99a compatibility stuff Claus Gittinger <cg@exept.de> parents: 1737 diff changeset	2037	startUpOrNil
f9e5700bd99a compatibility stuff Claus Gittinger <cg@exept.de> parents: 1737 diff changeset	2038	"realize the menu at the current pointer position
1836 89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2039	return the value of the selectedItem or nil, of none was selected
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2040	(unless the menu has already performed its action, by sending an appropriate message
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2041	to some performer)
1750 f9e5700bd99a compatibility stuff Claus Gittinger <cg@exept.de> parents: 1737 diff changeset	2042	"
f9e5700bd99a compatibility stuff Claus Gittinger <cg@exept.de> parents: 1737 diff changeset	2043	^ self showAtPointer
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2044	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	2045
dce33f8bb806 intitial checkin ca parents: diff changeset	2046	!MenuPanel methodsFor:'adding & removing'!
dce33f8bb806 intitial checkin ca parents: diff changeset	2047
dce33f8bb806 intitial checkin ca parents: diff changeset	2048	createAtIndex:anIndexOrNil
1800 600f247a2846 comment Claus Gittinger <cg@exept.de> parents: 1799 diff changeset	2049	"create an item and add this item to the index. In case of nil, the item
600f247a2846 comment Claus Gittinger <cg@exept.de> parents: 1799 diff changeset	2050	is added to the end. If the index is not valid nil is returned;
600f247a2846 comment Claus Gittinger <cg@exept.de> parents: 1799 diff changeset	2051	otherwise the new created item is returned.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2052	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2053	\|max item\|
dce33f8bb806 intitial checkin ca parents: diff changeset	2054
dce33f8bb806 intitial checkin ca parents: diff changeset	2055	max := (items size) + 1.
dce33f8bb806 intitial checkin ca parents: diff changeset	2056
dce33f8bb806 intitial checkin ca parents: diff changeset	2057	anIndexOrNil notNil ifTrue:[
1800 600f247a2846 comment Claus Gittinger <cg@exept.de> parents: 1799 diff changeset	2058	(anIndexOrNil < 1 or:[anIndexOrNil > max]) ifTrue:[
600f247a2846 comment Claus Gittinger <cg@exept.de> parents: 1799 diff changeset	2059	^ nil
600f247a2846 comment Claus Gittinger <cg@exept.de> parents: 1799 diff changeset	2060	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2061	].
dce33f8bb806 intitial checkin ca parents: diff changeset	2062	items isNil ifTrue:[
1800 600f247a2846 comment Claus Gittinger <cg@exept.de> parents: 1799 diff changeset	2063	items := OrderedCollection new
1151 199863d6a463 items: convert Array to OrderedCollection Claus Gittinger <cg@exept.de> parents: 1137 diff changeset	2064	] ifFalse:[
1800 600f247a2846 comment Claus Gittinger <cg@exept.de> parents: 1799 diff changeset	2065	items := items asOrderedCollection
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2066	].
dce33f8bb806 intitial checkin ca parents: diff changeset	2067	item := Item in:self.
dce33f8bb806 intitial checkin ca parents: diff changeset	2068
dce33f8bb806 intitial checkin ca parents: diff changeset	2069	(anIndexOrNil isNil or:[anIndexOrNil == max]) ifTrue:[
1800 600f247a2846 comment Claus Gittinger <cg@exept.de> parents: 1799 diff changeset	2070	items add:item
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2071	] ifFalse:[
1800 600f247a2846 comment Claus Gittinger <cg@exept.de> parents: 1799 diff changeset	2072	items add:item beforeIndex:anIndexOrNil
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2073	].
dce33f8bb806 intitial checkin ca parents: diff changeset	2074	^ item
dce33f8bb806 intitial checkin ca parents: diff changeset	2075	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2076
dce33f8bb806 intitial checkin ca parents: diff changeset	2077	remove:stringOrNumber
dce33f8bb806 intitial checkin ca parents: diff changeset	2078	"remove the first item which is assigned to stringOrNumber;
dce33f8bb806 intitial checkin ca parents: diff changeset	2079	if found, remove and return it
dce33f8bb806 intitial checkin ca parents: diff changeset	2080	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2081	\|item\|
dce33f8bb806 intitial checkin ca parents: diff changeset	2082
dce33f8bb806 intitial checkin ca parents: diff changeset	2083	(item := self itemAt:stringOrNumber) notNil ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	2084	items remove:item.
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	2085	item destroy.
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	2086	items isEmpty ifTrue:[items := nil].
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	2087	self mustRearrange.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2088	].
dce33f8bb806 intitial checkin ca parents: diff changeset	2089	^ item
dce33f8bb806 intitial checkin ca parents: diff changeset	2090	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2091
dce33f8bb806 intitial checkin ca parents: diff changeset	2092	removeAll
dce33f8bb806 intitial checkin ca parents: diff changeset	2093	"remove all items and submenus
dce33f8bb806 intitial checkin ca parents: diff changeset	2094	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2095	self disabledRedrawDo:[
2050 ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	2096	self selection:nil.
ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	2097	groupSizes := nil.
ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	2098	items notNil ifTrue:[
ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	2099	items copy do:[:el\| el destroy ].
ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	2100	].
ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	2101	items := nil
ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	2102	].
ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	2103
ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	2104	"Modified: / 15.11.2001 / 17:02:51 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2105	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	2106
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2107	!MenuPanel methodsFor:'change & update'!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2108
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2109	update:something with:aParameter from:changedObject
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	2110
b4c341497621 bug fixes: ca parents: 475 diff changeset	2111	changedObject == menuHolder ifTrue:[^ self menu:(menuHolder value)].
b4c341497621 bug fixes: ca parents: 475 diff changeset	2112	changedObject == enableChannel ifTrue:[^ self enabled:(enableChannel value)].
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2113
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2114	super update:something with:aParameter from:changedObject
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2115	! !
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2116
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2117	!MenuPanel methodsFor:'converting'!
dce33f8bb806 intitial checkin ca parents: diff changeset	2118
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2119	asMenu
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2120	"convert contents to menu
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2121	"
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2122	\|menu\|
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2123
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2124	menu := Menu new.
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2125	menu groupSizes:groupSizes.
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2126	self do:[:anItem\| menu addItem:(anItem asMenuItem) ].
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	2127	^ menu
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2128	!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2129
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2130	fromSpec:aMenuSpec
dce33f8bb806 intitial checkin ca parents: diff changeset	2131	"build from spec
dce33f8bb806 intitial checkin ca parents: diff changeset	2132	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2133	\|menu\|
dce33f8bb806 intitial checkin ca parents: diff changeset	2134
dce33f8bb806 intitial checkin ca parents: diff changeset	2135	menu := Menu new.
dce33f8bb806 intitial checkin ca parents: diff changeset	2136	menu fromLiteralArrayEncoding:aMenuSpec.
dce33f8bb806 intitial checkin ca parents: diff changeset	2137	self menu:menu
dce33f8bb806 intitial checkin ca parents: diff changeset	2138
dce33f8bb806 intitial checkin ca parents: diff changeset	2139	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2140
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2141	menu:aMenu
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2142	"convert to Menu
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2143	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2144	self disabledRedrawDo:[
1666 cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2145	\|menu newItems\|
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2146
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2147	self removeAll.
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2148
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2149	(menu := aMenu) notNil ifTrue:[
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2150	(aMenu isCollection) ifTrue:[
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2151	menu := Menu new.
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2152	menu fromLiteralArrayEncoding:aMenu.
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2153	] ifFalse:[
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2154	menu receiver notNil ifTrue:[receiver := menu receiver]
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2155	].
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2156	(newItems := menu menuItems) size > 0 ifTrue:[
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2157	items := newItems collect:[:ni \|
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2158	\|i\|
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2159
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2160	i:= Item in:self.
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2161	i menuItem:ni.
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2162	i.
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2163	].
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2164	].
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2165	self groupSizes:(menu groupSizes).
cbeea1429021 checkin from browser Claus Gittinger <cg@exept.de> parents: 1660 diff changeset	2166	]
1063 08b7ca464437 dont show accelerators for horizontal layouts Claus Gittinger <cg@exept.de> parents: 1054 diff changeset	2167	]
08b7ca464437 dont show accelerators for horizontal layouts Claus Gittinger <cg@exept.de> parents: 1054 diff changeset	2168
08b7ca464437 dont show accelerators for horizontal layouts Claus Gittinger <cg@exept.de> parents: 1054 diff changeset	2169	"Modified: / 8.8.1998 / 02:05:04 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2170	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	2171
dce33f8bb806 intitial checkin ca parents: diff changeset	2172	!MenuPanel methodsFor:'drawing'!
dce33f8bb806 intitial checkin ca parents: diff changeset	2173
dce33f8bb806 intitial checkin ca parents: diff changeset	2174	disabledRedrawDo:aBlock
dce33f8bb806 intitial checkin ca parents: diff changeset	2175	"evaluate a block without redrawing within the block; after processing
dce33f8bb806 intitial checkin ca parents: diff changeset	2176	of the block a redraw might be performed
dce33f8bb806 intitial checkin ca parents: diff changeset	2177	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2178	\|state\|
dce33f8bb806 intitial checkin ca parents: diff changeset	2179
dce33f8bb806 intitial checkin ca parents: diff changeset	2180	state := mustRearrange.
dce33f8bb806 intitial checkin ca parents: diff changeset	2181	mustRearrange := true.
dce33f8bb806 intitial checkin ca parents: diff changeset	2182	aBlock value.
dce33f8bb806 intitial checkin ca parents: diff changeset	2183	mustRearrange := state.
dce33f8bb806 intitial checkin ca parents: diff changeset	2184	self mustRearrange
dce33f8bb806 intitial checkin ca parents: diff changeset	2185	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2186
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2187	drawButtonEdgesFor:anItem level:aLevel
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2188	\|layout\|
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2189
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2190	aLevel ~~ 0 ifTrue:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2191	layout := anItem layout.
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2192
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2193	styleSheet is3D ifFalse:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2194	self displayRectangle:layout.
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2195	] ifTrue:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2196	self drawEdgesForX:(layout left)
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2197	y:(layout top)
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2198	width:(layout width)
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2199	height:(layout height)
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2200	level:aLevel
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2201	shadow:buttonShadowColor
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2202	light:buttonLightColor
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2203	halfShadow:buttonHalfShadowColor
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2204	halfLight:buttonHalfLightColor
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2205	style:ButtonEdgeStyle
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2206	]
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2207	]
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2208	!
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2209
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2210	drawItemsX:x y:y width:w height:h
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2211	"redraw items and groups in a damage
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2212	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2213	\|isVertical item layout prevClip
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2214	x1 "{ Class:SmallInteger }"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2215	x2 "{ Class:SmallInteger }"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2216	y1 "{ Class:SmallInteger }"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2217	y2 "{ Class:SmallInteger }"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2218	start "{ Class:SmallInteger }"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2219	stop "{ Class:SmallInteger }"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2220	size "{ Class:SmallInteger }"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2221	groupDivInset "{ Class:SmallInteger }"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2222	\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2223
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2224	size := items size.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2225	isVertical := self verticalLayout.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2226
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2227	isVertical ifTrue:[
2064 0e0d1fe431fb checkin from browser Claus Gittinger <cg@exept.de> parents: 2063 diff changeset	2228	start := items findFirst:[:el\| \|l\| l := el layout. l notNil and:[l bottom > y]].
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2229	start == 0 ifTrue:[ ^ self ].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2230	y1 := y + h.
2064 0e0d1fe431fb checkin from browser Claus Gittinger <cg@exept.de> parents: 2063 diff changeset	2231	stop := items findFirst:[:el\| \|l\| l := el layout. l notNil and:[l top > y1] ]
0e0d1fe431fb checkin from browser Claus Gittinger <cg@exept.de> parents: 2063 diff changeset	2232	startingAt:(start + 1).
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2233	] ifFalse:[
2064 0e0d1fe431fb checkin from browser Claus Gittinger <cg@exept.de> parents: 2063 diff changeset	2234	start := items findFirst:[:el\| \|l\| l := el layout. l notNil and:[l right > x ]].
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2235	start == 0 ifTrue:[ ^ self ].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2236	x1 := x + w.
2064 0e0d1fe431fb checkin from browser Claus Gittinger <cg@exept.de> parents: 2063 diff changeset	2237	stop := items findFirst:[:el\| \|l\| l := el layout.l notNil and:[l left > x1]]
0e0d1fe431fb checkin from browser Claus Gittinger <cg@exept.de> parents: 2063 diff changeset	2238	startingAt:(start + 1).
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2239	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2240	stop == 0 ifTrue:[stop := size] ifFalse:[stop := stop - 1].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2241
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2242	(groupSizes size ~~ 0 and:[self showGroupDivider]) ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2243	groupDivInset := groupDividerSize // 2.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2244
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2245	groupDivInset ~~ 0 ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2246	(start ~~ 1 and:[self hasGroupDividerAt:(start-1)]) ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2247	start := start - 1
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2248	]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2249	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2250	] ifFalse:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2251	groupDivInset := 0
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2252	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2253
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2254	prevClip := clipRect.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2255	self clippingRectangle:(Rectangle left:x top:y width:w height:h).
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2256
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2257	start to:stop do:[:i\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2258	item := items at:i.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2259	item redraw.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2260
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2261	(groupDivInset ~~ 0 and:[i ~~ size and:[self hasGroupDividerAt:i]]) ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2262	layout := item layout.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2263
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2264	isVertical ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2265	x1 := layout left.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2266	x2 := layout right.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2267	y1 := layout bottom + groupDivInset.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2268	y2 := y1.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2269	] ifFalse:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2270	y1 := layout top.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2271	y2 := layout bottom.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2272	x1 := layout right + groupDivInset.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2273	x2 := x1.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2274	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2275	self paint:shadowColor.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2276	self displayLineFromX:x1 y:y1 toX:x2 y:y2.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2277	self paint:lightColor.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2278
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2279	isVertical ifTrue:[y1 := y1 + 1. y2 := y1 ]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2280	ifFalse:[x1 := x1 + 1. x2 := x1 ].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2281
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2282	self displayLineFromX:x1 y:y1 toX:x2 y:y2
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2283	]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2284	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2285	self clippingRectangle:prevClip.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2286	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2287
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2288	drawLabelEdgeFor:anItem selected:isSelected
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2289	\|level layout\|
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2290
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2291	isSelected ifTrue:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2292	level := onLevel
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2293	] ifFalse:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2294	anItem == enteredItem ifTrue:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2295	level := DefaultEnteredLevel
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2296	] ifFalse:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2297	level := offLevel
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2298	]
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2299	].
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	2300
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	2301	level ~~ 0 ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2302	layout := anItem layout.
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2303
1691 8e1a9d7a298e bugfix in drawLableEdge... ca parents: 1690 diff changeset	2304	self drawEdgesForX:(layout left)
8e1a9d7a298e bugfix in drawLableEdge... ca parents: 1690 diff changeset	2305	y:(layout top)
8e1a9d7a298e bugfix in drawLableEdge... ca parents: 1690 diff changeset	2306	width:(layout width)
8e1a9d7a298e bugfix in drawLableEdge... ca parents: 1690 diff changeset	2307	height:(layout height)
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2308	level:level
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2309	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2310
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2311	!
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2312
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2313	drawScrollerAt:aDirection bounds:bounds
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2314	"draw a scroller
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2315	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2316	\|scrolling icon level x y w h\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2317
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2318	x := bounds left.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2319	y := bounds top.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2320	w := bounds width.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2321	h := bounds height.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2322
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	2323	scrolling := self scrollActivity.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2324
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2325	(scrolling activeMenu == self and:[scrolling direction == aDirection]) ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2326	level := -2
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2327	] ifFalse:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2328	level := 1
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2329	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2330
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2331	level ~~ 0 ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2332	self drawEdgesForX:x y:y width:w height:h level:level.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2333	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2334	icon := scrolling iconAt:aDirection on:self.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2335
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2336	icon displayOn:self x:(x + (w - icon width // 2))
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2337	y:(y + (h - icon height // 2)).
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2338	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2339
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2340	invalidateItem:anItem repairNow:aBool
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2341	"an item changed; invalidate the items layout
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2342	"
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2343	\|layout\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2344
2073 26c30a04413d do not invalidate if sensor is nil Claus Gittinger <cg@exept.de> parents: 2069 diff changeset	2345	self sensor isNil ifTrue:[^ self].
26c30a04413d do not invalidate if sensor is nil Claus Gittinger <cg@exept.de> parents: 2069 diff changeset	2346
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2347	(mustRearrange not and:[shown]) ifTrue:[
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2348	layout := anItem layout.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2349
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2350	(layout bottom > margin and:[layout top < (height - margin)]) ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2351	self invalidate:(layout copy insetBy:-1) repairNow:aBool
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2352	]
1728 fc0bd6482feb kludge redraw bug fix Claus Gittinger <cg@exept.de> parents: 1727 diff changeset	2353	].
fc0bd6482feb kludge redraw bug fix Claus Gittinger <cg@exept.de> parents: 1727 diff changeset	2354
fc0bd6482feb kludge redraw bug fix Claus Gittinger <cg@exept.de> parents: 1727 diff changeset	2355	"Modified: / 29.2.2000 / 11:28:59 / cg"
746 bd252bbe276f better drawing routine for button behavior tz parents: 739 diff changeset	2356	!
bd252bbe276f better drawing routine for button behavior tz parents: 739 diff changeset	2357
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2358	invalidateX:x y:y width:w height:h
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2359	"add a damage to redraw part of the view
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2360	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2361	shown ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2362	self invalidate:(Rectangle left:x top:y width:w height:h)
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2363	repairNow:false
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2364	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2365	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2366
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2367	mustRearrange
910 5c9592e782fd always repairNow (to make change visible immediately) Claus Gittinger <cg@exept.de> parents: 898 diff changeset	2368	"force rearrange (i.e. set the rearrange flag)
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2369	"
2080 f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2370	mustRearrange ifFalse:[
f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2371	mustRearrange := true.
f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2372	shown ifTrue:[
f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2373	self invalidate "/ RepairNow:true
f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2374	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2375	]
590 3177528b5f95 checkin from browser Claus Gittinger <cg@exept.de> parents: 587 diff changeset	2376
911 6b1ad8b039c5 no, repairNow should not be needed here Claus Gittinger <cg@exept.de> parents: 910 diff changeset	2377	"Modified: / 6.6.1998 / 19:51:07 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2378	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2379
710 4453e463ff16 add new feature: ca parents: 709 diff changeset	2380	rearrangeGroups
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2381	"implements the groupIdentifier #right in a horizontal menu
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2382	"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2383	\|layout point
710 4453e463ff16 add new feature: ca parents: 709 diff changeset	2384	dltX "{ Class:SmallInteger }"
4453e463ff16 add new feature: ca parents: 709 diff changeset	2385	start "{ Class:SmallInteger }"
4453e463ff16 add new feature: ca parents: 709 diff changeset	2386	\|
4453e463ff16 add new feature: ca parents: 709 diff changeset	2387
4453e463ff16 add new feature: ca parents: 709 diff changeset	2388	(self isPopUpView or:[self verticalLayout]) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2389	^ self
710 4453e463ff16 add new feature: ca parents: 709 diff changeset	2390	].
4453e463ff16 add new feature: ca parents: 709 diff changeset	2391
4453e463ff16 add new feature: ca parents: 709 diff changeset	2392	layout := items last layout.
4453e463ff16 add new feature: ca parents: 709 diff changeset	2393
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2394	(dltX := width - margin - layout right) <= 0 ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2395	^ self "/ no free space
710 4453e463ff16 add new feature: ca parents: 709 diff changeset	2396	].
4453e463ff16 add new feature: ca parents: 709 diff changeset	2397	start := items findFirst:[:anItem\| anItem startGroup == #right ].
4453e463ff16 add new feature: ca parents: 709 diff changeset	2398
4453e463ff16 add new feature: ca parents: 709 diff changeset	2399	start == 0 ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2400	^ self "/ no item detected
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2401	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2402	point := dltX @ 0.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2403
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2404	"/ move items layout to right
710 4453e463ff16 add new feature: ca parents: 709 diff changeset	2405
4453e463ff16 add new feature: ca parents: 709 diff changeset	2406	items from:start do:[:anItem\|
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2407	anItem isVisible ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2408	anItem layout moveBy:point.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2409	]
710 4453e463ff16 add new feature: ca parents: 709 diff changeset	2410	].
4453e463ff16 add new feature: ca parents: 709 diff changeset	2411	!
4453e463ff16 add new feature: ca parents: 709 diff changeset	2412
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2413	rearrangeItems
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2414	"recompute the layout of each item
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2415	!!!!!! changes have influence on method #preferredExtentOfItems !!!!!!
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2416	"
1791 bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	2417	\|isVertical extent isPopUpMenu
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2418	x "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2419	y "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2420	x0 "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2421	y0 "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2422	x1 "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2423	y1 "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2424	size "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2425	inset "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2426	labelInset "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2427	buttonInset "{ Class:SmallInteger }"
710 4453e463ff16 add new feature: ca parents: 709 diff changeset	2428	\|
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2429	(mustRearrange and:[(size := items size) ~~ 0]) ifFalse:[
1478 38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	2430	mustRearrange := false.
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2431	^ self
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2432	].
2080 f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2433	"/ DON'T SET THIS!!
f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2434	"/ item layout: below of first item -> item invalidate
f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2435	"/ -> menuPanel invalidateItem:repairDamage:
f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2436	"/ -> invalidate:rapairDamage:
f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2437	"/ -> redrawX:y:width:height:
f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2438	"/ tries to get uninitialized layout from second item.
f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2439	"/ This happens in a modal debugger!!
f37673e44158 Fix rearrangeItem stuff Stefan Vogel <sv@exept.de> parents: 2079 diff changeset	2440	"/ mustRearrange := false.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2441	isVertical := self verticalLayout.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2442	buttonInset := DefaultButtonItemSpace abs.
1791 bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	2443	isPopUpMenu := self isPopUpView.
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	2444
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	2445	isPopUpMenu ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2446	labelInset := DefaultEnteredLevel abs.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2447	] ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2448	labelInset := 0
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2449	].
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2450
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2451	(isPopUpMenu or:[explicitExtent ~~ true]) ifTrue:[ \|savExt maxExt\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2452	savExt := extent := self preferredExtent copy.
1478 38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	2453
1791 bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	2454	isPopUpMenu ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2455	isVertical ifTrue:[extent y:1.0] ifFalse:[extent x:1.0]
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2456	] ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2457	savExt := extent copy.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2458	maxExt := self maxExtent.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2459
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2460	isVertical ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2461	extent y:(extent y min:(maxExt y))
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2462	] ifFalse:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2463	extent x:(extent x min:(maxExt x))
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2464	]
1478 38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	2465	].
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2466	self extent:extent.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2467	extent := savExt.
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2468	] ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2469	extent := self computeExtent
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2470	].
1082 382324ddce3f support and additional buttonSpacing (for normal and win95 styles) Claus Gittinger <cg@exept.de> parents: 1081 diff changeset	2471
1093 7cb44303b016 margin fixes Claus Gittinger <cg@exept.de> parents: 1090 diff changeset	2472	x := y := margin.
7cb44303b016 margin fixes Claus Gittinger <cg@exept.de> parents: 1090 diff changeset	2473
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2474	isVertical ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2475	y0 := margin.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2476	y1 := extent y - margin.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2477
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2478	items keysAndValuesDo:[:anIndex :el\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2479	el isVisible ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2480	el layout:(Rectangle left:x top:y0 right:x bottom:y1)
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2481	] ifTrue:[
1478 38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	2482	el isButton ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2483	inset := DefaultButtonItemSpace
2062 31ba9af25394 checkin from browser Claus Gittinger <cg@exept.de> parents: 2061 diff changeset	2484	] ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2485	inset := labelInset
1478 38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	2486	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2487	x0 := x + inset.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2488	x1 := x0 + el preferredExtent x.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2489	el layout:(Rectangle left:x0 top:(y0 + inset) right:x1 bottom:(y1 - inset)).
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2490	x := x1 + inset.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2491
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2492	size ~~ anIndex ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2493	(self hasGroupDividerAt:anIndex) ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2494	x := x + groupDividerSize
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2495	] ifFalse:[
1723 f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	2496	el isLabeledItem ifTrue:[
f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	2497	x := x + itemSpace
f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	2498	]
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2499	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2500	]
1478 38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	2501	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2502	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2503	] ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2504	x0 := margin.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2505	x1 := extent x - margin. "/ -1
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2506
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2507	items keysAndValuesDo:[:anIndex :el\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2508	el isVisible ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2509	el layout:(Rectangle left:x0 top:y right:x1 bottom:y)
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2510	] ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2511	el isButton ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2512	inset := DefaultButtonItemSpace
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2513	] ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2514	inset := labelInset
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2515	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2516	y0 := y + inset.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2517	y1 := y0 + el preferredExtent y.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2518	el layout:(Rectangle left:(x0 + inset) top:y0 right:(x1 - inset) bottom:y1).
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2519	y := y1 + inset.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2520
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2521	size ~~ anIndex ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2522	(self hasGroupDividerAt:anIndex) ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2523	y := y + groupDividerSize
1723 f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	2524	"/ ] ifFalse:[
f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	2525	"/ y := y + itemSpace
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2526	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2527	]
1478 38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	2528	]
38f08dec8e34 #on: -> #onDevice: Claus Gittinger <cg@exept.de> parents: 1475 diff changeset	2529	]
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	2530	].
710 4453e463ff16 add new feature: ca parents: 709 diff changeset	2531	self rearrangeGroups.
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	2532	selection notNil ifTrue:[self makeItemVisible:selection].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2533	mustRearrange := false.
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	2534
ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	2535	"Modified: / 13.11.2001 / 20:17:21 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2536	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2537
1217 c6a4c536aa8c care for items which change visibility via Claus Gittinger <cg@exept.de> parents: 1212 diff changeset	2538	rearrangeItemsIfItemVisibilityChanged
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2539	"check for items which can change its visibility;
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2540	if at least one item exists, rearrange all items
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2541	"
1464 3070de4c8b88 checkin from browser Claus Gittinger <cg@exept.de> parents: 1459 diff changeset	2542	items isNil ifTrue:[^ self].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2543
1217 c6a4c536aa8c care for items which change visibility via Claus Gittinger <cg@exept.de> parents: 1212 diff changeset	2544	items do:[:item \|
1464 3070de4c8b88 checkin from browser Claus Gittinger <cg@exept.de> parents: 1459 diff changeset	2545	item canChangeVisibility ifTrue:[
3070de4c8b88 checkin from browser Claus Gittinger <cg@exept.de> parents: 1459 diff changeset	2546	mustRearrange := true.
3070de4c8b88 checkin from browser Claus Gittinger <cg@exept.de> parents: 1459 diff changeset	2547	self rearrangeItems.
3070de4c8b88 checkin from browser Claus Gittinger <cg@exept.de> parents: 1459 diff changeset	2548	^ self
3070de4c8b88 checkin from browser Claus Gittinger <cg@exept.de> parents: 1459 diff changeset	2549	].
1217 c6a4c536aa8c care for items which change visibility via Claus Gittinger <cg@exept.de> parents: 1212 diff changeset	2550	]
c6a4c536aa8c care for items which change visibility via Claus Gittinger <cg@exept.de> parents: 1212 diff changeset	2551	!
c6a4c536aa8c care for items which change visibility via Claus Gittinger <cg@exept.de> parents: 1212 diff changeset	2552
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2553	redrawX:x y:y width:w height:h
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2554	"redraw a damage
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2555	"
2052 61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2556	\|y0 y1 x0 x1 bounds mustDrawPrevScroller mustDrawNextScroller\|
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2557
710 4453e463ff16 add new feature: ca parents: 709 diff changeset	2558	(shown and:[w ~~ 0]) ifFalse:[^ self].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2559
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2560	mustRearrange ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2561	self isPopUpView not ifTrue:[explicitExtent := true].
1387 ad7a920fdf61 less flicker by using a clipRect in redraw Claus Gittinger <cg@exept.de> parents: 1382 diff changeset	2562	self rearrangeItems.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2563	^ self invalidate
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2564	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2565	self paint:(self backgroundColor).
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2566	self clearRectangleX:x y:y width:w height:h.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2567
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2568	items size == 0 ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2569	^ self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2570	].
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2571	y0 := y.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2572	y1 := y + h.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2573	x0 := x.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2574	x1 := x + w.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2575
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2576	self hasScrollers ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2577	(self hasScrollerAt:#PREV) ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2578	bounds := self scrollerBoundsAt:#PREV.
2052 61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2579	mustDrawPrevScroller := false.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2580
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2581	self verticalLayout ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2582	bounds bottom > y ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2583	y0 := bounds bottom.
2052 61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2584	mustDrawPrevScroller := true.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2585	].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2586	] ifFalse:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2587	bounds right > x ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2588	x0 := bounds right.
2052 61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2589	mustDrawPrevScroller := true.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2590	].
2052 61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2591	].
61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2592	mustDrawPrevScroller ifTrue:[
61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2593	self drawScrollerAt:#PREV bounds:bounds.
61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2594	].
1387 ad7a920fdf61 less flicker by using a clipRect in redraw Claus Gittinger <cg@exept.de> parents: 1382 diff changeset	2595	].
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2596
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2597	(self hasScrollerAt:#NEXT) ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2598	bounds := self scrollerBoundsAt:#NEXT.
2052 61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2599	mustDrawNextScroller := false.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2600
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2601	self verticalLayout ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2602	bounds top < y1 ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2603	y1 := bounds top.
2052 61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2604	mustDrawNextScroller := true.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2605	]
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2606	] ifFalse:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2607	bounds left < x1 ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2608	x1 := bounds left.
2052 61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2609	mustDrawNextScroller := true.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2610	]
2052 61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2611	].
61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2612	mustDrawNextScroller ifTrue:[
61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2613	self drawScrollerAt:#NEXT bounds:bounds.
61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2614	].
1387 ad7a920fdf61 less flicker by using a clipRect in redraw Claus Gittinger <cg@exept.de> parents: 1382 diff changeset	2615	]
ad7a920fdf61 less flicker by using a clipRect in redraw Claus Gittinger <cg@exept.de> parents: 1382 diff changeset	2616	].
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2617	(y1 > y0 and:[x1 > x0]) ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2618	self drawItemsX:x0 y:y0 width:(x1 - x0) height:(y1 - y0)
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2619	].
2052 61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2620
61367c7a47aa * empty log message * Claus Gittinger <cg@exept.de> parents: 2051 diff changeset	2621	"Modified: / 15.11.2001 / 20:57:32 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2622	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	2623
dce33f8bb806 intitial checkin ca parents: diff changeset	2624	!MenuPanel methodsFor:'enumerting & searching'!
dce33f8bb806 intitial checkin ca parents: diff changeset	2625
dce33f8bb806 intitial checkin ca parents: diff changeset	2626	collect:aOneArgBlock
dce33f8bb806 intitial checkin ca parents: diff changeset	2627	"evaluate the argument, aOneArgBlock for every item in the menuPanel
dce33f8bb806 intitial checkin ca parents: diff changeset	2628	and return a collection of the results
dce33f8bb806 intitial checkin ca parents: diff changeset	2629	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2630	items notNil ifTrue:[^ items collect:aOneArgBlock ].
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	2631	^ nil
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2632	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2633
dce33f8bb806 intitial checkin ca parents: diff changeset	2634	do:aOneArgBlock
dce33f8bb806 intitial checkin ca parents: diff changeset	2635	"evaluate the argument, aOneArgBlock for every item in the menuPanel.
dce33f8bb806 intitial checkin ca parents: diff changeset	2636	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2637	items notNil ifTrue:[ items do:aOneArgBlock ].
dce33f8bb806 intitial checkin ca parents: diff changeset	2638
dce33f8bb806 intitial checkin ca parents: diff changeset	2639	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2640
dce33f8bb806 intitial checkin ca parents: diff changeset	2641	findFirst:aOneArgBlock
dce33f8bb806 intitial checkin ca parents: diff changeset	2642	"find the first item, for which evaluation of the argument, aOneArgBlock
dce33f8bb806 intitial checkin ca parents: diff changeset	2643	returns true; return its index or 0 if none detected.
dce33f8bb806 intitial checkin ca parents: diff changeset	2644	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2645	items notNil ifTrue:[ ^ items findFirst:aOneArgBlock ].
dce33f8bb806 intitial checkin ca parents: diff changeset	2646	^ 0
dce33f8bb806 intitial checkin ca parents: diff changeset	2647
dce33f8bb806 intitial checkin ca parents: diff changeset	2648	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2649
dce33f8bb806 intitial checkin ca parents: diff changeset	2650	findLast:aOneArgBlock
dce33f8bb806 intitial checkin ca parents: diff changeset	2651	"find the last item, for which evaluation of the argument, aOneArgBlock
dce33f8bb806 intitial checkin ca parents: diff changeset	2652	returns true; return its index or 0 if none detected.
dce33f8bb806 intitial checkin ca parents: diff changeset	2653	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2654	items notNil ifTrue:[ ^ items findLast:aOneArgBlock ].
dce33f8bb806 intitial checkin ca parents: diff changeset	2655	^ 0
dce33f8bb806 intitial checkin ca parents: diff changeset	2656
dce33f8bb806 intitial checkin ca parents: diff changeset	2657	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2658
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2659	indexOf:something
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2660	"returns index of an item assigned to an index, nameKey, textLabel or value if symbol.
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2661	If no item match 0 is returned. No range checks are performed on a number argument
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2662	"
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2663	\|i v\|
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2664
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2665	something isNumber ifTrue:[ ^ something ].
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2666	something isNil ifTrue:[ ^ 0 ].
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2667
1218 6ce43fcb2603 code cleanup Claus Gittinger <cg@exept.de> parents: 1217 diff changeset	2668	i := self findFirst:[:el \| (el nameKey = something) or: [el = something]].
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2669
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2670	i ~~ 0 ifTrue:[
1368 eb9b2f411240 redraw Claus Gittinger <cg@exept.de> parents: 1367 diff changeset	2671	^ i
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2672	].
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2673
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2674	something isSymbol ifTrue:[
1368 eb9b2f411240 redraw Claus Gittinger <cg@exept.de> parents: 1367 diff changeset	2675	i := self findFirst:[:el\|
eb9b2f411240 redraw Claus Gittinger <cg@exept.de> parents: 1367 diff changeset	2676	v := el value.
eb9b2f411240 redraw Claus Gittinger <cg@exept.de> parents: 1367 diff changeset	2677	v isSymbol and:[v == something]
eb9b2f411240 redraw Claus Gittinger <cg@exept.de> parents: 1367 diff changeset	2678	].
eb9b2f411240 redraw Claus Gittinger <cg@exept.de> parents: 1367 diff changeset	2679	i ~~ 0 ifTrue:[
eb9b2f411240 redraw Claus Gittinger <cg@exept.de> parents: 1367 diff changeset	2680	^ i
eb9b2f411240 redraw Claus Gittinger <cg@exept.de> parents: 1367 diff changeset	2681	]
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2682	].
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2683
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	2684	(something respondsTo:#string) ifTrue:[
1368 eb9b2f411240 redraw Claus Gittinger <cg@exept.de> parents: 1367 diff changeset	2685	v := something string.
1218 6ce43fcb2603 code cleanup Claus Gittinger <cg@exept.de> parents: 1217 diff changeset	2686	^ self findFirst:[:el \| el textLabel = v].
6ce43fcb2603 code cleanup Claus Gittinger <cg@exept.de> parents: 1217 diff changeset	2687	].
6ce43fcb2603 code cleanup Claus Gittinger <cg@exept.de> parents: 1217 diff changeset	2688	^ 0
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2689	!
dce33f8bb806 intitial checkin ca parents: diff changeset	2690
706 d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	2691	indexOfItem:anItem
d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	2692	"returns the index of the item or 0
d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	2693	"
d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	2694	^ items notNil ifTrue:[items identityIndexOf:anItem] ifFalse:[0]
d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	2695	!
d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	2696
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2697	keysAndValuesDo:aTwoArgBlock
dce33f8bb806 intitial checkin ca parents: diff changeset	2698	"evaluate the argument, aTwoArgBlock for every item in the menuPanel.
dce33f8bb806 intitial checkin ca parents: diff changeset	2699	"
dce33f8bb806 intitial checkin ca parents: diff changeset	2700	items notNil ifTrue:[ items keysAndValuesDo:aTwoArgBlock ].
dce33f8bb806 intitial checkin ca parents: diff changeset	2701
dce33f8bb806 intitial checkin ca parents: diff changeset	2702	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	2703
dce33f8bb806 intitial checkin ca parents: diff changeset	2704	!MenuPanel methodsFor:'event handling'!
dce33f8bb806 intitial checkin ca parents: diff changeset	2705
dce33f8bb806 intitial checkin ca parents: diff changeset	2706	buttonMotion:state x:x y:y
dce33f8bb806 intitial checkin ca parents: diff changeset	2707	"open or close the corresponding submenus
dce33f8bb806 intitial checkin ca parents: diff changeset	2708	"
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	2709	\|menue motionPoint translatedPoint sensor\|
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2710
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	2711	self scrollActivity isActive ifTrue:[
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2712	^ self
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2713	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2714
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2715	sensor := self sensor.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2716
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2717	(sensor isNil or:[sensor hasButtonMotionEventFor:nil]) ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2718	^ self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2719	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2720	menue := self detectGrabMenu.
1841 5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	2721
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	2722	motionPoint := x@y.
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	2723	translatedPoint := menue translateGrabPoint:motionPoint.
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	2724	menue handleButtonMotion:state atPoint:translatedPoint.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2725
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2726	(self isPopUpView or:[sensor anyButtonPressed]) ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2727	^ self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2728	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2729
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2730	(selection notNil and:[selection visibleSubmenu isNil]) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2731	"/ selection on grabView withou a submenu (Button ...); check whether moving out
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	2732	(self containsPoint:motionPoint) ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2733	^ self accept:nil
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2734	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2735	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2736
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	2737	"Modified: / 13.11.2001 / 20:21:49 / cg"
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2738	!
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2739
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2740	buttonPress:button x:x y:y
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2741	"any button pressed; open or close the corresponding submenus
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2742	"
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2743	\|menu point\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2744
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	2745	self scrollActivity stop.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2746	point := x@y.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2747	menu := self detectMenuAtGrabPoint:point.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2748
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2749	menu isNil ifTrue:[
2133 293dadf237ad hide on buttonRelease outside (instead of buttonPress outside) Claus Gittinger <cg@exept.de> parents: 2132 diff changeset	2750	"/ self accept:nil
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2751	] ifFalse:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2752	point := menu translateGrabPoint:point.
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	2753	menu handleButtonPressAtPoint:point.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2754	]
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	2755
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	2756	"Modified: / 13.11.2001 / 14:12:32 / cg"
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2757	!
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2758
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2759	buttonRelease:button x:x y:y
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2760	"button release action; accept selection and close all views
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2761	"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2762	\|topMenu dstMenu item srcPoint dstPoint\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2763
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	2764	self scrollActivity stop ifTrue:[
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2765	^ self
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2766	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2767
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2768	topMenu := self topMenu.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2769	dstMenu := topMenu activeMenu.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2770
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2771	( dstMenu selection notNil
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2772	or:[dstMenu isPopUpView not
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2773	or:[(OperatingSystem millisecondTimeDeltaBetween:(Time millisecondClockValue)
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2774	and:(dstMenu mapTime)) > 400]]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	2775	) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2776	srcPoint := x@y.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2777
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2778	( (dstMenu := self detectMenuAtGrabPoint:srcPoint) notNil
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2779	and:[(item := dstMenu selection) notNil]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2780	) ifTrue:[
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2781	item visibleSubmenu notNil ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2782	dstMenu selection:nil.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2783
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2784	(selection isNil and:[self isPopUpView not]) ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2785	self accept:nil
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2786	]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2787	] ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2788	item currentSubmenu isNil ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2789	dstPoint := dstMenu translateGrabPoint:srcPoint.
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2790
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2791	(dstMenu itemAtX:(dstPoint x) y:(dstPoint y)) == dstMenu selection ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2792	item := nil
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2793	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2794	topMenu acceptItem:item inMenu:dstMenu.
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2795	]
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2796	].
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2797	^ self
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2798	].
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2799
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2800	(selection notNil and:[dstMenu == self]) ifTrue:[
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2801	selection visibleSubmenu notNil ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2802	^ self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2803	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2804	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2805	self accept:nil.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2806	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2807	!
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2808
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2809	keyPress:key x:x y:y
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2810	"any key is pressed
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2811	"
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2812	\|menu rawKey\|
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2813
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	2814	self scrollActivity isActive ifTrue:[
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2815	key ~~ #Escape ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2816	^ self
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2817	].
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	2818	self scrollActivity stop
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2819	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2820
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2821	(key == #Tab
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2822	or:[key == #FocusNext
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2823	or:[key == #FocusPrevious]]) ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2824	self accept:nil.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2825	^ super keyPress:key x:x y:y
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2826	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2827
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2828	menu := self detectGrabMenu.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2829
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2830	key == #Escape ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2831	"/ must hide the active menu
1703 e127eff742bb bugfix: request focus ca parents: 1701 diff changeset	2832	((menu := menu superMenu) notNil and:[menu ~~ self]) ifTrue:[
e127eff742bb bugfix: request focus ca parents: 1701 diff changeset	2833	"/ hide active menu but keep the grab
e127eff742bb bugfix: request focus ca parents: 1701 diff changeset	2834	menu selection:nil
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2835	] ifFalse:[
1703 e127eff742bb bugfix: request focus ca parents: 1701 diff changeset	2836	"/ hide active menu and ungrab
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2837	self accept:nil
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2838	]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2839	] ifFalse:[
1793 f76529768dd6 keyPress:... check for wrapped view ca parents: 1791 diff changeset	2840	menu isViewWrapper ifFalse:[
f76529768dd6 keyPress:... check for wrapped view ca parents: 1791 diff changeset	2841	self sensor compressKeyPressEventsWithKey:key.
f76529768dd6 keyPress:... check for wrapped view ca parents: 1791 diff changeset	2842
f76529768dd6 keyPress:... check for wrapped view ca parents: 1791 diff changeset	2843	menu handleKeyPress:key.
f76529768dd6 keyPress:... check for wrapped view ca parents: 1791 diff changeset	2844
1836 89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2845	"/ selection isNil ifTrue:[
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2846	"/ self accept:nil keepValue:true
89a1b938c09e fixed returned value from non-performing menu Claus Gittinger <cg@exept.de> parents: 1832 diff changeset	2847	"/ ]
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2848	]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	2849	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2850	!
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2851
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2852	pointerLeave:state
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	2853	self scrollActivity isActive ifTrue:[^ self].
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2854
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2855	self detectGrabMenu handlePointerLeave:state.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2856
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2857	self isPopUpView ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2858	^ self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2859	].
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2860	(selection notNil and:[selection hasSubmenu not]) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2861	"/ selection on grabView withou a submenu (Button ...); check whether moving out
2141 1a9381cdeb13 turn off button when leaving the view with mouse-button pressed Claus Gittinger <cg@exept.de> parents: 2137 diff changeset	2862	"/ self sensor anyButtonPressed ifFalse:[
1a9381cdeb13 turn off button when leaving the view with mouse-button pressed Claus Gittinger <cg@exept.de> parents: 2137 diff changeset	2863	self accept:nil.
1a9381cdeb13 turn off button when leaving the view with mouse-button pressed Claus Gittinger <cg@exept.de> parents: 2137 diff changeset	2864	"/ ].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2865	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2866	!
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2867
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2868	sizeChanged:how
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2869	"redraw #right groups
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2870	"
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2871	self isPopUpView ifFalse:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2872	mustRearrange := true.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2873	shown ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	2874	self invalidate
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2875	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2876	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2877	super sizeChanged:how
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2878	! !
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2879
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2880	!MenuPanel methodsFor:'event handling processing'!
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2881
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2882	clearImplicitGrab
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2883	self menuAdornmentAt:#implicitGrabView put:nil.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2884	self menuAdornmentAt:#lastPointerView put:nil.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2885
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2886
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2887	!
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2888
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2889	dispatchEvent:ev withFocusOn:focusView delegate:doDelegate
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2890	"dispatch and handle an event
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2891	"
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2892	\|view x y p syntheticEvent implicitGrabView lastPointerView menu\|
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2893
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2894	implicitGrabView := self menuAdornmentAt:#implicitGrabView.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2895
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2896	"/ situation: we get a buttonPress, set implicitGrab (for scrollbars etc.)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2897	"/ but never get the buttonRelease, since someone else (a popUp) grabbed the
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2898	"/ pointer in the meantime, and has eaten the release event ... (double-sigh)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2899	implicitGrabView notNil ifTrue:[
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2900	self sensor leftButtonPressed ifFalse:[
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2901	self clearImplicitGrab.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2902	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2903	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2904
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2905	((x := ev x) isNil or:[(y := ev y) isNil]) ifTrue:[
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2906	^ super dispatchEvent:ev withFocusOn:focusView delegate:false.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2907	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2908
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2909	implicitGrabView notNil ifTrue:[
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2910	ev isButtonEvent ifTrue:[
2020 1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	2911	p := device translatePoint:(x@y) fromView:self toView:implicitGrabView.
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2912	ev view:implicitGrabView.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2913	ev arguments at:2 put:p x.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2914	ev arguments at:3 put:p y.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2915	implicitGrabView dispatchEvent:ev withFocusOn:focusView delegate:false.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2916
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2917	ev isButtonReleaseEvent ifTrue:[
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2918	self clearImplicitGrab.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2919	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2920	^ self
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2921	]
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2922	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2923	menu := self detectMenuAtGrabPoint:(x@y).
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2924
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	2925	(menu isNil or:[menu isViewWrapper not]) ifTrue:[
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2926	self clearImplicitGrab.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2927	^ super dispatchEvent:ev withFocusOn:focusView delegate:false
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2928	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2929
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2930	p := menu translateGrabPoint:(x@y).
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2931	view := self detectViewAtX:(p x) y:(p y) in:menu.
2020 1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	2932	p := device translatePoint:(x@y) fromView:self toView:view.
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2933
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2934	ev isButtonPressEvent ifTrue:[
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2935	(view wantsFocusWithButtonPress) ifTrue:[
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2936	view requestFocus.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2937	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2938	view ~~ self ifTrue:[ "/ can this ever be self ?
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2939	self menuAdornmentAt:#implicitGrabView put:view.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2940	]
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2941	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2942	lastPointerView := self menuAdornmentAt:#lastPointerView.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2943
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2944	ev isButtonMotionEvent ifTrue:[
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2945	lastPointerView ~~ view ifTrue:[
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2946	"/ must generate enter/leave ... (sigh)
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2947	lastPointerView notNil ifTrue:[
2125 67e0f2c9ad4d event types are private to WindowEvent; ca parents: 2123 diff changeset	2948	"/ XXX: should be fixed
67e0f2c9ad4d event types are private to WindowEvent; ca parents: 2123 diff changeset	2949	syntheticEvent := WindowEvent pointerLeave:0 view:lastPointerView.
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2950	lastPointerView dispatchEvent:syntheticEvent withFocusOn:nil delegate:false.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2951	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2952	view notNil ifTrue:[
2125 67e0f2c9ad4d event types are private to WindowEvent; ca parents: 2123 diff changeset	2953	syntheticEvent := WindowEvent pointerEnter:0 x:x y:y view:view.
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2954	view dispatchEvent:syntheticEvent withFocusOn:nil delegate:false.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2955	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2956	self menuAdornmentAt:#lastPointerView put:view.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2957	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2958	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2959
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2960	ev view:view.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2961	ev x:p x.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2962	ev y:p y.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2963	view dispatchEvent:ev withFocusOn:focusView delegate:false.
2020 1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	2964
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	2965	"Modified: / 10.10.2001 / 13:54:47 / cg"
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2966	!
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	2967
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	2968	handleButtonMotion:state atPoint:motionPoint
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2969	"open or close the corresponding submenus
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2970	"
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	2971	\|menu translatedPoint sel\|
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2972
1910 119f91172b70 * empty log message * Claus Gittinger <cg@exept.de> parents: 1902 diff changeset	2973	(state == 0 or:[self sensor anyButtonPressed not]) ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2974	"/ highlight enterItem if no selection exists
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2975	selection isNil ifTrue:[
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	2976	(self containsPoint:motionPoint) ifTrue:[
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	2977	((sel := self itemAtPoint:motionPoint) isNil or:[sel canSelect not]) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2978	^ self pointerEntersItem:nil
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2979	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2980	(DefaultSelectionFollowsMouse and:[superMenu notNil]) ifTrue:[
2061 faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	2981	self select:sel openMenu:true.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	2982	"/ self openMenuOnSelect:true.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	2983	"/ self selection:sel.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	2984	"/ self openMenuOnSelect:nil.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2985	] ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2986	self pointerEntersItem:sel
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2987	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2988	^ self
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2989	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2990	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	2991	self pointerEntersItem:nil.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2992
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	2993	(DefaultSelectionFollowsMouse and:[(menu := self superMenuAtPoint:motionPoint) notNil]) ifTrue:[
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	2994	translatedPoint := self translateMenuPoint:motionPoint toMenu:menu.
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	2995	sel := menu itemAtPoint:translatedPoint.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2996
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	2997	(sel notNil and:[sel canSelect]) ifTrue:[
2096 8bb413648b84 bugfix in mode: DefaultSelectionFollowsMouse == true ca parents: 2084 diff changeset	2998	menu select:sel openMenu:true.
2061 faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	2999	"/ self openMenuOnSelect:true.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	3000	"/ self selection:sel.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	3001	"/ self openMenuOnSelect:nil.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3002	]
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3003	].
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	3004	^ self
ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	3005	].
ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	3006
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3007	self pointerEntersItem:nil.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3008
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	3009	(menu := self superMenuAtPoint:motionPoint) isNil ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3010	self isPopUpView ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3011	self selection:nil
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3012	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3013	^ self
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3014	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3015
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3016	menu == self ifTrue:[
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	3017	(sel := self itemAtPoint:motionPoint) notNil ifTrue:[
2061 faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	3018	self select:sel openMenu:true.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	3019	"/ self openMenuOnSelect:true.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	3020	"/ self selection:sel.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	3021	"/ self openMenuOnSelect:nil.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3022	].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3023	] ifFalse:[
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	3024	translatedPoint := self translateMenuPoint:motionPoint toMenu:menu.
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	3025	sel := menu itemAtPoint:translatedPoint.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3026
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3027	(sel isNil and:[menu isPopUpView not]) ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3028	sel := menu selection.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3029	].
2061 faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	3030	menu select:sel openMenu:true.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	3031	"/ menu openMenuOnSelect:true.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	3032	"/ menu selection:sel.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	3033	"/ menu openMenuOnSelect:nil.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3034	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3035
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	3036	"Created: / 13.11.2001 / 20:21:24 / cg"
ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	3037	"Modified: / 13.11.2001 / 20:26:32 / cg"
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	3038	!
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	3039
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	3040	handleButtonPressAtPoint:aPoint
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3041	"a button pressed; open or close the corresponding submenus
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3042	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3043	\|item sensor yS direction\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3044
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	3045	item := self itemAtPoint:aPoint.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3046
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3047	item notNil ifTrue:[
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	3048	direction := self scrollerDirectionAtPoint:aPoint.
2047 62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	3049	direction notNil ifTrue:[
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	3050	(self scrollActivity startIfRequiredAt:direction on:self) ifTrue:[
2047 62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	3051	self pointerEntersItem:nil.
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	3052	^ self
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	3053	]
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3054	]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3055	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3056
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3057	self openMenuOnSelect:true.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3058	self selection:item.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3059	self openMenuOnSelect:nil.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3060
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	3061	item isNil ifTrue:[^ self].
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	3062
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	3063	(item triggerOnDown not
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	3064	and:[item delayMenu]
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	3065	) ifTrue:[
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	3066	self halt.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	3067	].
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	3068
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	3069	(item triggerOnDown
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3070	and:[item canAccept
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	3071	and:[item == self selection]]
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3072	) ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3073	self invalidateItem:item repairNow:true.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3074	self acceptItem:item inMenu:self.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3075
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3076	self selection == item ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3077	(sensor := self sensor) notNil ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3078	[sensor anyButtonPressed] whileTrue:[ Delay waitForSeconds:0.1 ].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3079	sensor flushUserEvents.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3080	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3081	self selection:nil.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3082	]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3083	].
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	3084
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	3085	"Created: / 13.11.2001 / 14:12:04 / cg"
2047 62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	3086	"Modified: / 13.11.2001 / 19:50:52 / cg"
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3087	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3088
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3089	handleCursorKey:aKey
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3090	"handle a cursor key
dce33f8bb806 intitial checkin ca parents: diff changeset	3091	"
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3092	\|next menu item isVrt backKey p1 p2
687 23ce9888d76f bug fixes: ca parents: 681 diff changeset	3093	idx "{ Class:SmallInteger }"
1705 201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3094	size "{ Class:SmallInteger }"
687 23ce9888d76f bug fixes: ca parents: 681 diff changeset	3095	\|
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3096	(size := items size) == 0 ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3097	superMenu notNil ifTrue:[superMenu handleCursorKey:aKey].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3098	^ self
dce33f8bb806 intitial checkin ca parents: diff changeset	3099	].
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3100
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3101	isVrt := self verticalLayout.
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3102
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3103
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3104	( (isVrt and:[aKey == #CursorUp or:[aKey == #CursorDown]])
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3105	or:[(isVrt not and:[aKey == #CursorRight or:[aKey == #CursorLeft]])]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3106	) ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3107	selection isNil ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3108	(superMenu notNil and:[superMenu verticalLayout == isVrt]) ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3109	^ superMenu handleCursorKey:aKey
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3110	].
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3111	idx := 0.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3112
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3113	isVrt ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3114	"/ used because of vertical scrolling
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3115	idx := items findFirst:[:el\| el layout top > 0 ].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3116	idx ~~ 0 ifTrue:[idx := idx := idx - 1 ]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3117	].
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3118	] ifFalse:[
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3119	idx := self indexOf:selection.
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3120	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3121	next := aKey == #CursorRight or:[aKey == #CursorDown].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3122
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3123	size timesRepeat:[\|el\|
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3124	next ifTrue:[(idx := idx + 1) > size ifTrue:[idx := 1]]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3125	ifFalse:[(idx := idx - 1) < 1 ifTrue:[idx := size]].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3126
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3127	(el := items at:idx ifAbsent:nil) notNil ifTrue:[
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	3128	el canSelect ifTrue:[^ self selection:el].
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3129	]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3130	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3131	^ self
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3132	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3133
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3134	superMenu notNil ifTrue:[
1791 bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3135	p1 := self translateGrabPoint:0.
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3136	p2 := superMenu translateGrabPoint:0.
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3137	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3138
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3139	isVrt ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3140	(superMenu notNil and:[p1 x > p2 x]) ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3141	backKey := #CursorRight
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3142	] ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3143	backKey := #CursorLeft.
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3144	]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3145	] ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3146	(superMenu notNil and:[p1 y > p2 y]) ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3147	backKey := #CursorDown
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3148	] ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3149	backKey := #CursorUp.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3150	]
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3151	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3152
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3153	aKey == backKey ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3154	superMenu isNil ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3155	self accept:nil
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3156	] ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3157	superMenu verticalLayout ~~ isVrt ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3158	superMenu handleCursorKey:aKey
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3159	] ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3160	superMenu selection hideSubmenu
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3161	]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3162	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3163	^ self
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3164	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3165
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3166	selection isNil ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3167	superMenu isNil ifTrue:[^ self accept:nil].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3168
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3169	superMenu verticalLayout ~~ isVrt ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3170	superMenu handleCursorKey:aKey
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3171	] ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3172	(item := items findFirst:[:el\| el canSelect]) notNil ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3173	self selection:item
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3174	]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3175	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3176	^ self
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3177	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3178
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3179	selection hasSubmenu ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3180	(menu := selection visibleSubmenu) isNil ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3181	selection toggleSubmenuVisibility
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3182	] ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3183	menu selectionIndex:1
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3184	]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3185	] ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3186	superMenu notNil ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3187	superMenu verticalLayout ~~ isVrt ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3188	superMenu handleCursorKey:aKey
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3189	]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3190	] ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3191	self accept:nil
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3192	]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3193	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3194	!
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3195
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3196	handleKeyPress:key
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3197	"any key is pressed
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3198	"
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3199	\|item inMenu rawKey\|
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3200
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3201	(key == #Return or:[key == Character space]) ifTrue:[
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3202	self handleReturnPressed
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3203	] ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3204	key isCharacter ifTrue:[
1862 ffbe4c06defd handleKeyPress: search character-key in wrapped menu ca parents: 1853 diff changeset	3205	"/ selection notNil ifTrue:[
ffbe4c06defd handleKeyPress: search character-key in wrapped menu ca parents: 1853 diff changeset	3206	"/ inMenu := self
ffbe4c06defd handleKeyPress: search character-key in wrapped menu ca parents: 1853 diff changeset	3207	"/ ] ifFalse:[
ffbe4c06defd handleKeyPress: search character-key in wrapped menu ca parents: 1853 diff changeset	3208	"/ (inMenu := superMenu) isNil ifTrue:[^ self].
ffbe4c06defd handleKeyPress: search character-key in wrapped menu ca parents: 1853 diff changeset	3209	"/ ].
ffbe4c06defd handleKeyPress: search character-key in wrapped menu ca parents: 1853 diff changeset	3210	inMenu := self.
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3211
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3212	(item := inMenu detectItemForKey:key) notNil ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3213	inMenu selection:item
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3214	]
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3215	] ifFalse:[
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3216	( key == #CursorDown or:[key == #CursorUp
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3217	or:[key == #CursorLeft or:[key == #CursorRight]]]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3218	) ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3219	self handleCursorKey:key
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3220	]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3221	]
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	3222	]
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	3223	!
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3224
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3225	handlePointerLeave:state
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3226	self pointerEntersItem:nil.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3227	super pointerLeave:state
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3228	!
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3229
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3230	handleReturnPressed
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3231	"any key is pressed
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3232	"
1841 5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3233	\|sensor\|
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3234
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3235	selection isNil ifTrue:[
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3236	superMenu notNil ifTrue:[
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3237	superMenu selection toggleSubmenuVisibility
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3238	] ifFalse:[
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3239	self accept
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3240	].
1841 5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3241	^ self
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3242	].
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3243	selection hasSubmenu ifTrue:[
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3244	^ selection toggleSubmenuVisibility
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3245	].
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3246	self accept.
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3247
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3248	(selection notNil and:[selection triggerOnDown]) ifFalse:[
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3249	^ self
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3250	].
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3251
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3252	(sensor := self sensor) isNil ifTrue:[
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3253	^ self
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3254	].
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3255
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3256	[ sensor flushKeyboardFor:nil.
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3257	Delay waitForSeconds:0.1.
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3258	sensor hasKeyPressEventFor:nil.
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3259
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3260	] whileTrue.
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	3261
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3262	!
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	3263
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3264	pointerEntersItem:anItemOrNil
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3265	"the pointer moves over an item or nil; restore the old item and
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3266	redraw the new item highlighted.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3267	"
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3268	\|oldItem newItem\|
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3269
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3270	( anItemOrNil notNil
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3271	and:[anItemOrNil canSelect
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3272	and:[selection isNil
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3273	and:[self isPopUpView not]]]) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3274	anItemOrNil isButton ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3275	( buttonEnteredBgColor ~= ButtonPassiveBackgroundColor
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3276	or:[ButtonEnteredLevel ~~ ButtonPassiveLevel]
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3277	) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3278	newItem := anItemOrNil
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3279	]
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3280	] ifFalse:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3281	DefaultEnteredLevel ~~ 0 ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3282	newItem := anItemOrNil
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3283	]
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3284	]
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3285	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3286
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3287	newItem ~~ enteredItem ifTrue:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3288	oldItem := enteredItem.
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3289	enteredItem := newItem.
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3290
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3291	oldItem notNil ifTrue:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3292	self invalidateItem:oldItem repairNow:(enteredItem isNil).
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3293	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3294
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3295	enteredItem notNil ifTrue:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3296	self invalidateItem:enteredItem repairNow:true.
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3297	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3298	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3299
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3300	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	3301
dce33f8bb806 intitial checkin ca parents: diff changeset	3302	!MenuPanel methodsFor:'grabbing'!
dce33f8bb806 intitial checkin ca parents: diff changeset	3303
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3304	doGrab
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3305	relativeGrabOrigin := nil.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3306
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3307	superMenu notNil ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3308	superMenu doGrab
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3309	] ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3310	hasImplicitGrap ~~ true ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3311	self grabMouseAndKeyboard.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3312	hasImplicitGrap := true
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3313	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3314	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3315	!
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3316
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3317	doUngrab:forceDo
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3318
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3319	relativeGrabOrigin := nil.
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	3320	self clearImplicitGrab.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3321
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3322	superMenu notNil ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3323	forceDo ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3324	superMenu doUngrab:true
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3325	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3326	^ self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3327	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3328
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3329	hasImplicitGrap ~~ true ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3330	^ self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3331	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3332
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3333	forceDo ifFalse:[
1703 e127eff742bb bugfix: request focus ca parents: 1701 diff changeset	3334	(selection notNil or:[prevFocusView == self]) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3335	^ self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3336	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3337	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3338	self ungrabMouseAndKeyboard.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3339	self selection:nil.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3340	hasImplicitGrap := nil.
1703 e127eff742bb bugfix: request focus ca parents: 1701 diff changeset	3341	prevFocusView := nil.
e127eff742bb bugfix: request focus ca parents: 1701 diff changeset	3342
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3343	!
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3344
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3345	grabKeyboard
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3346	"grap the keyboard; keep previous grab
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3347	"
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3348	previousKeyboardGrab := device activeKeyboardGrab.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3349	^ super grabKeyboard
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3350
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3351
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3352	!
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3353
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3354	grabMouseAndKeyboard
717 540e638fdebb Avoid pointer and keyboard grabbing if not necessary Stefan Vogel <sv@exept.de> parents: 712 diff changeset	3355	"get exclusive access to pointer and keyboard.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3356	"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3357	\|sensor\|
dce33f8bb806 intitial checkin ca parents: diff changeset	3358
dce33f8bb806 intitial checkin ca parents: diff changeset	3359	realized ifTrue:[
1703 e127eff742bb bugfix: request focus ca parents: 1701 diff changeset	3360	prevFocusView := self windowGroup focusView.
1612 42e2fce5a1f9 set focus back ca parents: 1610 diff changeset	3361
1575 c56d76e45113 force set focus ca parents: 1574 diff changeset	3362	sensor := self sensor.
c56d76e45113 force set focus ca parents: 1574 diff changeset	3363	device activePointerGrab ~~ self ifTrue:[
c56d76e45113 force set focus ca parents: 1574 diff changeset	3364	sensor notNil ifTrue:[
c56d76e45113 force set focus ca parents: 1574 diff changeset	3365	sensor flushMotionEventsFor:nil.
c56d76e45113 force set focus ca parents: 1574 diff changeset	3366	].
c56d76e45113 force set focus ca parents: 1574 diff changeset	3367
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3368	(self grabPointer) ifFalse:[
1575 c56d76e45113 force set focus ca parents: 1574 diff changeset	3369	Delay waitForSeconds:0.1.
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3370	(self grabPointer) ifFalse:[
1575 c56d76e45113 force set focus ca parents: 1574 diff changeset	3371	"give up"
c56d76e45113 force set focus ca parents: 1574 diff changeset	3372	'MenuPanel [warning]: could not grab pointer' errorPrintCR.
c56d76e45113 force set focus ca parents: 1574 diff changeset	3373	self unmap
c56d76e45113 force set focus ca parents: 1574 diff changeset	3374	]
c56d76e45113 force set focus ca parents: 1574 diff changeset	3375	]
c56d76e45113 force set focus ca parents: 1574 diff changeset	3376	].
c56d76e45113 force set focus ca parents: 1574 diff changeset	3377
c56d76e45113 force set focus ca parents: 1574 diff changeset	3378	device activeKeyboardGrab ~~ self ifTrue:[
c56d76e45113 force set focus ca parents: 1574 diff changeset	3379	sensor notNil ifTrue:[
c56d76e45113 force set focus ca parents: 1574 diff changeset	3380	device sync.
c56d76e45113 force set focus ca parents: 1574 diff changeset	3381	sensor flushKeyboardFor:nil
c56d76e45113 force set focus ca parents: 1574 diff changeset	3382	].
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3383	self grabKeyboard.
1575 c56d76e45113 force set focus ca parents: 1574 diff changeset	3384	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3385	]
dce33f8bb806 intitial checkin ca parents: diff changeset	3386
717 540e638fdebb Avoid pointer and keyboard grabbing if not necessary Stefan Vogel <sv@exept.de> parents: 712 diff changeset	3387	"Modified: / 2.2.1998 / 23:43:59 / stefan"
1254 38b8bcfabbd7 checkin from browser Claus Gittinger <cg@exept.de> parents: 1253 diff changeset	3388	"Modified: / 15.3.1999 / 12:01:38 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3389	!
dce33f8bb806 intitial checkin ca parents: diff changeset	3390
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3391	grabPointerWithCursor:aCursorOrNil
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3392	"grap the pointer; keep previous grab
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3393	"
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3394	previousPointerGrab := device activePointerGrab.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3395	hasImplicitGrap := true.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3396	^ super grabPointerWithCursor:aCursorOrNil
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3397
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3398
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3399	!
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3400
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3401	ungrabKeyboard
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3402	"ungrap the keyboard; restore previous grab
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3403	"
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3404	super ungrabKeyboard.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3405
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3406	previousKeyboardGrab notNil ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3407	device grabKeyboardInView:previousKeyboardGrab.
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3408	].
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3409
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3410
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3411	!
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3412
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3413	ungrabMouseAndKeyboard
717 540e638fdebb Avoid pointer and keyboard grabbing if not necessary Stefan Vogel <sv@exept.de> parents: 712 diff changeset	3414	"ungrab resources (mouse and keyboard)
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3415	"
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3416	self ungrabPointer.
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3417	self ungrabKeyboard.
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3418	!
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3419
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3420	ungrabPointer
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3421	"ungrap the pointer; restore previous grab
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3422	"
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3423	super ungrabPointer.
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3424
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3425	previousPointerGrab notNil ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3426	device grabPointerInView:previousPointerGrab.
1630 01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3427	].
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3428
01dc20096011 grabbing cleaned up; ca parents: 1613 diff changeset	3429
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3430	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	3431
1251 eb5b4cdbacde fixed helpText display; Claus Gittinger <cg@exept.de> parents: 1250 diff changeset	3432	!MenuPanel methodsFor:'help'!
eb5b4cdbacde fixed helpText display; Claus Gittinger <cg@exept.de> parents: 1250 diff changeset	3433
2058 f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3434	flyByHelpTextAt:srcPoint
f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3435	"return the helpText for aPoint (i.e. when mouse-pointer is moved over an item).
2063 8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3436	If there is a selection, that items helpText is used (ignoring the given point).
2058 f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3437	"
f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3438	\|dstMenu dstPoint\|
f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3439
f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3440	dstMenu := self detectMenuAtGrabPoint:srcPoint.
2063 8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3441	dstMenu isNil ifTrue:[^ nil].
2058 f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3442
f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3443	dstPoint := dstMenu translateGrabPoint:srcPoint.
2063 8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3444	^ dstMenu flyByHelpTextForItem:(dstMenu itemAtX:(dstPoint x) y:(dstPoint y)).
2058 f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3445	!
f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3446
f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3447	flyByHelpTextForItem:anItem
f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3448	"returns the helpText for an item (empty if none)
f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3449	"
2063 8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3450	\|key app\|
8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3451
8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3452	anItem isNil ifTrue:[^ nil].
8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3453
8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3454	anItem isButton ifFalse:[^ nil].
8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3455
8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3456	key := anItem activeHelpKey.
8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3457	key isNil ifTrue:[^ nil].
8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3458
8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3459	app := self application.
8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3460	app isNil ifTrue:[^ nil].
8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3461
8bff9e49f1e9 * empty log message * Claus Gittinger <cg@exept.de> parents: 2062 diff changeset	3462	^ app flyByHelpTextForKey:key.
2058 f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3463	!
f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	3464
1251 eb5b4cdbacde fixed helpText display; Claus Gittinger <cg@exept.de> parents: 1250 diff changeset	3465	helpText
1613 5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3466	"return the helpText for the currently selected item (empty if none)
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3467	"
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3468	^ self helpTextForItem:selection
1251 eb5b4cdbacde fixed helpText display; Claus Gittinger <cg@exept.de> parents: 1250 diff changeset	3469	!
eb5b4cdbacde fixed helpText display; Claus Gittinger <cg@exept.de> parents: 1250 diff changeset	3470
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3471	helpTextAt:srcPoint
1252 6db6906da49b debug print Claus Gittinger <cg@exept.de> parents: 1251 diff changeset	3472	"return the helpText for aPoint (i.e. when mouse-pointer is moved over an item).
6db6906da49b debug print Claus Gittinger <cg@exept.de> parents: 1251 diff changeset	3473	If there is a selection, that items helpText is used (ignoreing the given point).
6db6906da49b debug print Claus Gittinger <cg@exept.de> parents: 1251 diff changeset	3474	"
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3475	\|dstMenu dstPoint\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3476
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3477	dstMenu := self detectMenuAtGrabPoint:srcPoint.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3478
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3479	dstMenu isNil ifTrue:[
1613 5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3480	^ ''
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3481	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3482
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3483	dstPoint := dstMenu translateGrabPoint:srcPoint.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3484	^ dstMenu helpTextForItem:(dstMenu itemAtX:(dstPoint x) y:(dstPoint y)).
1613 5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3485	!
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3486
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3487	helpTextForItem:anItem
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3488	"returns the helpText for an item (empty if none)
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3489	"
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3490	\|key val app\|
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3491
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3492	anItem isNil ifTrue:[^ ''].
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3493
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3494	(val := anItem activeHelpText) isNil ifTrue:[
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3495	( (key := anItem activeHelpKey) notNil
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3496	and:[(app := self application) notNil]
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3497	) ifTrue:[
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3498	val := app helpTextForKey:key.
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3499	].
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3500	anItem activeHelpText:(val ? '').
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3501	].
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	3502	^ val
1251 eb5b4cdbacde fixed helpText display; Claus Gittinger <cg@exept.de> parents: 1250 diff changeset	3503	! !
eb5b4cdbacde fixed helpText display; Claus Gittinger <cg@exept.de> parents: 1250 diff changeset	3504
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3505	!MenuPanel methodsFor:'image registration'!
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3506
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3507	imageOnDevice:anImage
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3508	"returns image registered on device
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3509	"
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3510	^ self class image:anImage onDevice:device
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3511	!
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3512
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3513	lightenedImageOnDevice:anImage
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3514	"returns lightened image registered on device
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3515	"
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3516	^ self class lightenedImage:anImage onDevice:device
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3517	! !
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	3518
1688 271829d6a2e4 category changes Claus Gittinger <cg@exept.de> parents: 1679 diff changeset	3519	!MenuPanel methodsFor:'initialization & release'!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3520
767 ffa2a09a1039 added #addToCurrentProject in order to avoid restart errors tz parents: 746 diff changeset	3521	addToCurrentProject
ffa2a09a1039 added #addToCurrentProject in order to avoid restart errors tz parents: 746 diff changeset	3522	"ignored here"
ffa2a09a1039 added #addToCurrentProject in order to avoid restart errors tz parents: 746 diff changeset	3523	!
ffa2a09a1039 added #addToCurrentProject in order to avoid restart errors tz parents: 746 diff changeset	3524
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3525	create
616 a6157b083830 support of different styles ca parents: 608 diff changeset	3526	"create the shadow view for a none contained submenu
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3527	"
dce33f8bb806 intitial checkin ca parents: diff changeset	3528	super create.
dce33f8bb806 intitial checkin ca parents: diff changeset	3529
dce33f8bb806 intitial checkin ca parents: diff changeset	3530	self isPopUpView ifTrue:[
1499 07951b17b43e allow for a device to suppress shadowViews. Claus Gittinger <cg@exept.de> parents: 1478 diff changeset	3531	(PopUpView shadowsOnDevice:device) ifTrue:[
07951b17b43e allow for a device to suppress shadowViews. Claus Gittinger <cg@exept.de> parents: 1478 diff changeset	3532	shadowView isNil ifTrue:[
07951b17b43e allow for a device to suppress shadowViews. Claus Gittinger <cg@exept.de> parents: 1478 diff changeset	3533	shadowView := (ShadowView onDevice:device) for:self
07951b17b43e allow for a device to suppress shadowViews. Claus Gittinger <cg@exept.de> parents: 1478 diff changeset	3534	] ifFalse:[
07951b17b43e allow for a device to suppress shadowViews. Claus Gittinger <cg@exept.de> parents: 1478 diff changeset	3535	self saveUnder:true.
07951b17b43e allow for a device to suppress shadowViews. Claus Gittinger <cg@exept.de> parents: 1478 diff changeset	3536	].
07951b17b43e allow for a device to suppress shadowViews. Claus Gittinger <cg@exept.de> parents: 1478 diff changeset	3537	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3538	] ifFalse:[
1499 07951b17b43e allow for a device to suppress shadowViews. Claus Gittinger <cg@exept.de> parents: 1478 diff changeset	3539	explicitExtent == true ifTrue:[
07951b17b43e allow for a device to suppress shadowViews. Claus Gittinger <cg@exept.de> parents: 1478 diff changeset	3540	(self width) == (superView width) ifTrue:[
07951b17b43e allow for a device to suppress shadowViews. Claus Gittinger <cg@exept.de> parents: 1478 diff changeset	3541	self verticalLayout:false
07951b17b43e allow for a device to suppress shadowViews. Claus Gittinger <cg@exept.de> parents: 1478 diff changeset	3542	]
07951b17b43e allow for a device to suppress shadowViews. Claus Gittinger <cg@exept.de> parents: 1478 diff changeset	3543	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3544	]
1024 28c87a2369f6 show active help on pointer motion. Claus Gittinger <cg@exept.de> parents: 1022 diff changeset	3545
28c87a2369f6 show active help on pointer motion. Claus Gittinger <cg@exept.de> parents: 1022 diff changeset	3546	"Modified: / 28.7.1998 / 02:11:44 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3547	!
dce33f8bb806 intitial checkin ca parents: diff changeset	3548
dce33f8bb806 intitial checkin ca parents: diff changeset	3549	destroy
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	3550	"destroy items and shadowView; remove dependencies
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3551	"
798 74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	3552	self clearLastActiveMenu.
2051 d958c12cc08e * empty log message * Claus Gittinger <cg@exept.de> parents: 2050 diff changeset	3553	items notNil ifTrue:[items copy do:[:el\|el destroy]].
2050 ef5517d7a2d0 do not destroy myself after accepting (for PopUpList) Claus Gittinger <cg@exept.de> parents: 2048 diff changeset	3554	items := nil.
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	3555
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	3556	menuHolder notNil ifTrue:[menuHolder removeDependent:self].
b4c341497621 bug fixes: ca parents: 475 diff changeset	3557	enableChannel notNil ifTrue:[enableChannel removeDependent:self].
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	3558
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3559	super destroy.
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	3560	superMenu := nil.
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	3561	shadowView notNil ifTrue:[shadowView destroy].
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	3562
2051 d958c12cc08e * empty log message * Claus Gittinger <cg@exept.de> parents: 2050 diff changeset	3563	"Modified: / 15.11.2001 / 17:08:45 / cg"
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	3564	!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	3565
616 a6157b083830 support of different styles ca parents: 608 diff changeset	3566	fetchDeviceResources
a6157b083830 support of different styles ca parents: 608 diff changeset	3567	"fetch device colors, to avoid reallocation at redraw time"
a6157b083830 support of different styles ca parents: 608 diff changeset	3568
a6157b083830 support of different styles ca parents: 608 diff changeset	3569	super fetchDeviceResources.
a6157b083830 support of different styles ca parents: 608 diff changeset	3570
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	3571	"/ thats a kludge - will be replaced by values from the styleSheet ...
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	3572	"/ (i.e. read menu.buttonActiveLevel & menu.buttonPassiveLevel)
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	3573
1331 aae37cbfb30a fixed style handling to avoid bad resizing when popup-level/bw Claus Gittinger <cg@exept.de> parents: 1330 diff changeset	3574	onLevel := styleSheet at:#'menu.hilightLevel' default:0.
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	3575
616 a6157b083830 support of different styles ca parents: 608 diff changeset	3576	superMenu isNil ifTrue:[
1705 201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3577	fgColor := DefaultForegroundColor onDevice:device.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3578	activeBgColor := DefaultHilightBackgroundColor onDevice:device.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3579	activeFgColor := DefaultHilightForegroundColor onDevice:device.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3580	disabledFgColor := DefaultDisabledForegroundColor onDevice:device.
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	3581	DefaultDisabledEtchedForegroundColor notNil ifTrue: [
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	3582	disabledEtchedFgColor := DefaultDisabledEtchedForegroundColor onDevice:device.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	3583	].
1705 201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3584	rightArrow := RightArrowForm onDevice:device.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3585	selectionFrameBrightColor := SelectionFrameBrightColor onDevice:device.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3586	selectionFrameDarkColor := SelectionFrameDarkColor onDevice:device.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3587	buttonLightColor := ButtonLightColor onDevice:device.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3588	buttonShadowColor := ButtonShadowColor onDevice:device.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3589	ButtonHalfLightColor notNil ifTrue: [
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3590	buttonHalfLightColor := ButtonHalfLightColor onDevice:device].
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3591	ButtonHalfShadowColor notNil ifTrue: [
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3592	buttonHalfShadowColor := ButtonHalfShadowColor onDevice:device].
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3593	buttonEnteredBgColor := ButtonEnteredBackgroundColor onDevice:device.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3594
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3595	(rightArrowShadow := RightArrowShadowForm) notNil ifTrue:[
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3596	rightArrowShadow := rightArrowShadow onDevice:device
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3597	]
616 a6157b083830 support of different styles ca parents: 608 diff changeset	3598	] ifFalse:[
1705 201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3599	fgColor := superMenu foregroundColor.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3600	activeBgColor := superMenu activeBackgroundColor.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3601	activeFgColor := superMenu activeForegroundColor.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3602	disabledFgColor := superMenu disabledForegroundColor.
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	3603	disabledEtchedFgColor := superMenu disabledEtchedForegroundColor.
1705 201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3604	rightArrow := superMenu rightArrow.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3605	rightArrowShadow := superMenu rightArrowShadow.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3606	selectionFrameBrightColor := superMenu selectionFrameBrightColor.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3607	selectionFrameDarkColor := superMenu selectionFrameDarkColor.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3608	buttonLightColor := superMenu buttonLightColor.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3609	buttonShadowColor := superMenu buttonShadowColor.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3610	buttonHalfLightColor := superMenu buttonHalfLightColor.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3611	buttonHalfShadowColor := superMenu buttonHalfShadowColor.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3612	buttonEnteredBgColor := superMenu buttonEnteredBackgroundColor.
1137 7df0b776e47a fixes for 2D styles (borderWidth) Claus Gittinger <cg@exept.de> parents: 1130 diff changeset	3613	].
7df0b776e47a fixes for 2D styles (borderWidth) Claus Gittinger <cg@exept.de> parents: 1130 diff changeset	3614
1829 bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	3615	items notNil ifTrue:[
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	3616	items do:[:eachItem \|
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	3617	eachItem fetchDeviceResources
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	3618	]
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	3619	].
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	3620
1137 7df0b776e47a fixes for 2D styles (borderWidth) Claus Gittinger <cg@exept.de> parents: 1130 diff changeset	3621	"Modified: / 15.9.1998 / 12:51:29 / cg"
616 a6157b083830 support of different styles ca parents: 608 diff changeset	3622	!
a6157b083830 support of different styles ca parents: 608 diff changeset	3623
580 249f6cfc5bb2 checkin from browser Claus Gittinger <cg@exept.de> parents: 571 diff changeset	3624	initStyle
249f6cfc5bb2 checkin from browser Claus Gittinger <cg@exept.de> parents: 571 diff changeset	3625	"initialize style specific stuff"
249f6cfc5bb2 checkin from browser Claus Gittinger <cg@exept.de> parents: 571 diff changeset	3626
249f6cfc5bb2 checkin from browser Claus Gittinger <cg@exept.de> parents: 571 diff changeset	3627	super initStyle.
616 a6157b083830 support of different styles ca parents: 608 diff changeset	3628
1336 6087005f59a8 checkin from browser Claus Gittinger <cg@exept.de> parents: 1332 diff changeset	3629	viewBackground := DefaultBackgroundColor.
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	3630
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3631	onLevel := DefaultHilightLevel.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3632	offLevel := 0. "/ DefaultLevel.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3633	itemSpace := DefaultItemSpace.
616 a6157b083830 support of different styles ca parents: 608 diff changeset	3634	groupDividerSize := DefaultGroupDividerSize.
1705 201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	3635	fitFirstPanel := false.
1829 bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	3636	font := MenuView defaultFont onDevice:device.
1923 530426a3d692 support #level: ca parents: 1922 diff changeset	3637
2003 732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3638	self updateLevelAndBorder.
580 249f6cfc5bb2 checkin from browser Claus Gittinger <cg@exept.de> parents: 571 diff changeset	3639	!
249f6cfc5bb2 checkin from browser Claus Gittinger <cg@exept.de> parents: 571 diff changeset	3640
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3641	initialize
dce33f8bb806 intitial checkin ca parents: diff changeset	3642	"set default configuration
dce33f8bb806 intitial checkin ca parents: diff changeset	3643	"
616 a6157b083830 support of different styles ca parents: 608 diff changeset	3644
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3645	super initialize.
616 a6157b083830 support of different styles ca parents: 608 diff changeset	3646
1730 4936edfc2eee must enable motion events in #initialize (not in map) Claus Gittinger <cg@exept.de> parents: 1728 diff changeset	3647	self enableMotionEvents.
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	3648	enabled := true.
1877 3b415fa4710f only access originChanged, extentChanged and cornerChanged Claus Gittinger <cg@exept.de> parents: 1874 diff changeset	3649	self extentChangedFlag:false.
3b415fa4710f only access originChanged, extentChanged and cornerChanged Claus Gittinger <cg@exept.de> parents: 1874 diff changeset	3650	self originChangedFlag:false.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3651	explicitExtent := nil.
dce33f8bb806 intitial checkin ca parents: diff changeset	3652	shortKeyInset := 0.
dce33f8bb806 intitial checkin ca parents: diff changeset	3653	mustRearrange := false.
dce33f8bb806 intitial checkin ca parents: diff changeset	3654	!
dce33f8bb806 intitial checkin ca parents: diff changeset	3655
1573 fd124ee2bce5 shortcutKeys; arrange layout if selection changed ca parents: 1572 diff changeset	3656	map
717 540e638fdebb Avoid pointer and keyboard grabbing if not necessary Stefan Vogel <sv@exept.de> parents: 712 diff changeset	3657	"grab the pointer here, when visible (but not if control has already been lost).
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3658	If the grab fails, try again and unmap myself if that fails too.
dce33f8bb806 intitial checkin ca parents: diff changeset	3659	"
1791 bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3660	\|loIndices loItems\|
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3661
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3662	enteredItem := nil.
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	3663
1024 28c87a2369f6 show active help on pointer motion. Claus Gittinger <cg@exept.de> parents: 1022 diff changeset	3664	self enableMotionEvents.
798 74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	3665	self becomesActiveMenu.
1573 fd124ee2bce5 shortcutKeys; arrange layout if selection changed ca parents: 1572 diff changeset	3666	super map.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3667
1785 efa4cc8ca917 mnemonic behaviour changed ca parents: 1775 diff changeset	3668	loIndices := InitialSelectionQuerySignal query.
1791 bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3669	loItems := items ? #[].
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3670
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3671	loItems do:[:anItem\| anItem fetchImages ].
1572 80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	3672
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3673	self isPopUpView ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3674	self doGrab
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	3675	] ifFalse:[
1572 80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	3676	super viewBackground:(self backgroundColor).
717 540e638fdebb Avoid pointer and keyboard grabbing if not necessary Stefan Vogel <sv@exept.de> parents: 712 diff changeset	3677	].
1791 bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3678	loItems do:[:el\| el updateIndicators ].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3679
1785 efa4cc8ca917 mnemonic behaviour changed ca parents: 1775 diff changeset	3680	loIndices size > 0 ifTrue:[
1572 80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	3681	self redrawX:0 y:0 width:width height:height.
1785 efa4cc8ca917 mnemonic behaviour changed ca parents: 1775 diff changeset	3682	self openMenusFromItemIndices:loIndices.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3683	].
dce33f8bb806 intitial checkin ca parents: diff changeset	3684
1177 cfd7f71639f3 checkin from browser Claus Gittinger <cg@exept.de> parents: 1164 diff changeset	3685	"Modified: / 19.11.1998 / 12:59:00 / cg"
1257 79a40d3f8c2f Use #query instead of #raise when invoking QuerySignals Stefan Vogel <sv@exept.de> parents: 1255 diff changeset	3686	"Modified: / 18.3.1999 / 18:22:18 / stefan"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3687	!
dce33f8bb806 intitial checkin ca parents: diff changeset	3688
dce33f8bb806 intitial checkin ca parents: diff changeset	3689	realize
dce33f8bb806 intitial checkin ca parents: diff changeset	3690	"realize menu and shadowView
dce33f8bb806 intitial checkin ca parents: diff changeset	3691	"
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	3692
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3693	self isPopUpView ifTrue:[
1459 53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	3694	"Because of #saveUnder of ShadowView the order of realize is significant:
53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	3695	shadowView must be realized before self"
53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	3696	self hiddenOnRealize:true.
53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	3697	super realize.
53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	3698	self resize.
53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	3699	self makeFullyVisible.
2003 732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3700	"/ self mustRearrange.
1459 53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	3701	shadowView notNil ifTrue:[
53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	3702	shadowView realize.
53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	3703	].
53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	3704	self raise.
1573 fd124ee2bce5 shortcutKeys; arrange layout if selection changed ca parents: 1572 diff changeset	3705	self map.
736 220741d8049b Use #saveUnder. Claus Gittinger <cg@exept.de> parents: 735 diff changeset	3706	] ifFalse:[
1459 53f83c83b354 checkin from browser Claus Gittinger <cg@exept.de> parents: 1455 diff changeset	3707	super realize.
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	3708	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	3709	self allSubViewsDo:[:aView\| aView realize ].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3710	!
dce33f8bb806 intitial checkin ca parents: diff changeset	3711
dce33f8bb806 intitial checkin ca parents: diff changeset	3712	recreate
1832 f6e6640e99a3 comment Claus Gittinger <cg@exept.de> parents: 1829 diff changeset	3713	"this is called after a snapin or a migration.
f6e6640e99a3 comment Claus Gittinger <cg@exept.de> parents: 1829 diff changeset	3714	If the image was saved with an active menu, hide the menu
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3715	"
1455 5685ec322a5b sizeChanged:... Claus Gittinger <cg@exept.de> parents: 1388 diff changeset	3716	selection := nil.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3717	super recreate.
dce33f8bb806 intitial checkin ca parents: diff changeset	3718	!
dce33f8bb806 intitial checkin ca parents: diff changeset	3719
1130 fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	3720	reinitStyle
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	3721	"handle style change while being open (win32 only - for now)"
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	3722
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	3723	super reinitStyle.
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	3724
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	3725	self fetchDeviceResources.
1811 df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	3726	self mustRearrange. "/ care for changed font sizes etc.
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	3727
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	3728	self do:[:anItem \|
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	3729	anItem reinitStyle
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	3730	].
1130 fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	3731
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	3732	"Created: / 10.9.1998 / 21:37:05 / cg"
1811 df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	3733	"Modified: / 17.8.2000 / 18:01:33 / cg"
1130 fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	3734	!
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	3735
1796 c9d801c011f7 recompute layout after snapIn (font geometry could be different) Claus Gittinger <cg@exept.de> parents: 1795 diff changeset	3736	reinitialize
c9d801c011f7 recompute layout after snapIn (font geometry could be different) Claus Gittinger <cg@exept.de> parents: 1795 diff changeset	3737	"reinit after a snapIn
c9d801c011f7 recompute layout after snapIn (font geometry could be different) Claus Gittinger <cg@exept.de> parents: 1795 diff changeset	3738	"
c9d801c011f7 recompute layout after snapIn (font geometry could be different) Claus Gittinger <cg@exept.de> parents: 1795 diff changeset	3739
c9d801c011f7 recompute layout after snapIn (font geometry could be different) Claus Gittinger <cg@exept.de> parents: 1795 diff changeset	3740	super reinitialize.
1811 df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	3741	"/ self reinitStyle.
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	3742
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	3743	"Modified: / 17.8.2000 / 17:53:31 / cg"
1796 c9d801c011f7 recompute layout after snapIn (font geometry could be different) Claus Gittinger <cg@exept.de> parents: 1795 diff changeset	3744	!
c9d801c011f7 recompute layout after snapIn (font geometry could be different) Claus Gittinger <cg@exept.de> parents: 1795 diff changeset	3745
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3746	unmap
1330 63d2fe5ebd48 comment Claus Gittinger <cg@exept.de> parents: 1313 diff changeset	3747	"unmap the view - the view stays created (but invisible), and can be remapped again later.
63d2fe5ebd48 comment Claus Gittinger <cg@exept.de> parents: 1313 diff changeset	3748	If we have a popup supermenu, it will get all keyboard and mouse events."
736 220741d8049b Use #saveUnder. Claus Gittinger <cg@exept.de> parents: 735 diff changeset	3749
798 74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	3750	self clearLastActiveMenu.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3751	self doUngrab:(superMenu isNil).
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3752	"/ self isPopUpView ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3753	"/ self doUngrab:(superMenu isNil)
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3754	"/ ].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	3755
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3756	super unmap.
dce33f8bb806 intitial checkin ca parents: diff changeset	3757	shadowView notNil ifTrue:[shadowView unmap].
2003 732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3758	!
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3759
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3760	updateLevelAndBorder
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3761	"update level & border, when it is known if I am a popUpView"
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3762
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3763	\|bw lvl\|
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3764
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3765	self isPopUpView ifTrue:[
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3766	bw := styleSheet at:#'popup.borderWidth' default:1.
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3767	lvl := styleSheet at:#'popup.level' default:0.
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3768	] ifFalse:[
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3769	bw := styleSheet is3D ifFalse:[1] ifTrue:[0].
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	3770	lvl := DefaultLevel.
2003 732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3771	].
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3772	self borderWidth:bw.
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3773	self level:lvl.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3774	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	3775
1878 1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3776	!MenuPanel methodsFor:'keyboard control'!
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3777
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3778	mnemonicViewNext:aKeyEvent
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3779	"a mnemonicKey event as forwarded from the keyboardProcessor - if there
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3780	is the mnemonic-key defined for any menuItem, handle the menuItem and
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3781	return the topMenu otherwise nil.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3782	"
2112 c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3783	\|menu uKey lKey list index\|
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3784
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3785	superMenu notNil ifTrue:[ ^ superMenu mnemonicViewNext:aKeyEvent ].
1878 1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3786	shown ifFalse:[^ nil].
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3787
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3788	uKey := aKeyEvent rawKey last asUppercase.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3789	lKey := uKey asLowercase.
2112 c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3790
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3791	selection notNil ifTrue:[
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3792	"first lookup the current grapMenu before starting in the topMenu
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3793	"
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3794	menu := self detectGrabMenu.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3795
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3796	[ menu ~~ self ] whileTrue:[
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3797	index := menu selectionIndex.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3798	list := menu selectItemIndicesFor:[:el\|\|k\| k := el accessCharacter. k == uKey or:[k == lKey]]
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3799	maxDepth:10 from:(index + 1) to:99999.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3800
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3801	list size ~~ 0 ifTrue:[
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3802	"/ has item which responds to the mnemonic
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3803	menu processCollectedIndices:list.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3804	^ self
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3805	].
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3806	menu := menu superMenu.
1878 1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3807	].
2112 c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3808	index := self selectionIndex.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3809	list := self selectItemIndicesFor:[:el\|\|k\| k := el accessCharacter. k == uKey or:[k == lKey] ]
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3810	maxDepth:10 from:(1 + index) to:99999.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3811	] ifFalse:[
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3812	index := 99999.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3813	list := nil.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3814	].
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3815
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3816	list ifNil:[
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3817	list := self selectItemIndicesFor:[:el\|\|k\| k := el accessCharacter. k == uKey or:[k == lKey] ]
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3818	maxDepth:10 from:1 to:index.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3819
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3820	list isNil ifTrue:[
1878 1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3821	"/ must clear existing selection
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3822	self selection:nil.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3823	^ nil
2112 c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3824	]
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3825	].
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3826
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3827	"/ has item which responds to the mnemonic
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3828	self processCollectedIndices:list.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3829	^ self
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	3830	!
1878 1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3831
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3832	openMenusFromItemIndices:anItemIndiceList
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3833	"open all menus derived from sequence of item indices
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3834	"
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3835	\|item\|
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3836
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3837	anItemIndiceList size == 0 ifTrue:[
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3838	^ self
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3839	].
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3840	item := self itemAt:(anItemIndiceList removeFirst).
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3841
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3842	(item notNil and:[item enabled]) ifTrue:[
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3843	InitialSelectionQuerySignal answer:anItemIndiceList do:[
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3844	self openMenuOnSelect:true.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3845	self selection:item.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3846	self openMenuOnSelect:nil.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3847	]
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	3848	].
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	3849	!
1878 1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3850
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3851	processCollectedIndices:indices
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3852	\|menu item\|
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3853
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3854	indices size == 0 ifTrue:[
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3855	^ self
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3856	].
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3857	menu := self.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3858
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3859	[menu selectionIndex == indices first] whileTrue:[
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3860	( (item := menu selection) isNil "/ shouldn't happen
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3861	or:[(menu := item submenu) isNil] "/ no more indices; done
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3862	) ifTrue:[
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3863	^ true
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3864	].
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3865	indices removeFirst.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3866
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3867	indices isEmpty ifTrue:[
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3868	menu selection:nil.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3869	^ self
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3870	]
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3871	].
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	3872	menu openMenusFromItemIndices:indices.
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	3873	!
1878 1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3874
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3875	processShortcut:aKeyEvent
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3876	"a shortcutKey event as forwarded from the keyboardProcessor - if there is the
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3877	shortcut-key defined process the shortcut and return true otherwise false.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3878	"
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3879	\|menu rKey lKey list item winGroup\|
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3880
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3881	superMenu notNil ifTrue:[
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3882	^ superMenu processShortcut:aKeyEvent
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3883	].
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3884	shown ifFalse:[^ false].
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3885
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3886	item := nil.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3887	rKey := aKeyEvent rawKey.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3888	lKey := aKeyEvent key.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3889	menu := self detectGrabMenu. "/ first lookup the current grapMenu before starting in the topMenu
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3890
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3891	[true] whileTrue:[
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3892	list := menu selectItemIndicesFor:[:el\|\|skey\|
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3893	item := el.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3894	skey := el shortcutKey.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3895	skey == rKey or:[skey == lKey]
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3896	]
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3897	maxDepth:10.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3898
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3899	list size ~~ 0 ifTrue:[
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3900	"/ has item which responds to the shortcut
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3901	item hasSubmenu ifFalse:[
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3902	menu accept:item
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3903	] ifTrue:[
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3904	menu processCollectedIndices:list.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3905	self windowGroup focusView:self.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3906	].
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3907	^ true
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3908	].
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3909
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3910	menu == self ifTrue:[ ^ false ].
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3911	menu := self.
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	3912	].
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	3913	!
1878 1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3914
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3915	selectItemIndicesFor:aOneArgBlock maxDepth:maxDepth
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3916	"returns the sequence of indices up to the item for which the block
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3917	returns true. The first entry is the topmenu, the last entry the
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3918	item for which the block returns true.
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3919	If no item is detected, nil is returned
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3920	"
2112 c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3921	^ self selectItemIndicesFor:aOneArgBlock maxDepth:maxDepth from:1 to:99999
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3922	!
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3923
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3924	selectItemIndicesFor:aOneArgBlock maxDepth:maxDepth from:aStart to:aStop
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3925	"returns the sequence of indices up to the item for which the block
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3926	returns true. The first entry is the topmenu, the last entry the
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3927	item for which the block returns true.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3928	If no item is detected, nil is returned
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3929	"
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3930	\|start stop\|
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3931
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3932	maxDepth <= 0 ifTrue:[^ nil].
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3933
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3934	start := aStart max:1.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3935	stop := aStop min:(items size).
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3936
2113 826d48809a17 mnemonic: first test block before enabled and visibility (optimize) ca parents: 2112 diff changeset	3937	start to:stop do:[:i\| \|item menu seq isItem\|
826d48809a17 mnemonic: first test block before enabled and visibility (optimize) ca parents: 2112 diff changeset	3938	item := items at:i.
826d48809a17 mnemonic: first test block before enabled and visibility (optimize) ca parents: 2112 diff changeset	3939	isItem := aOneArgBlock value:item.
826d48809a17 mnemonic: first test block before enabled and visibility (optimize) ca parents: 2112 diff changeset	3940
826d48809a17 mnemonic: first test block before enabled and visibility (optimize) ca parents: 2112 diff changeset	3941	(isItem or:[item hasSubmenu]) ifTrue:[
826d48809a17 mnemonic: first test block before enabled and visibility (optimize) ca parents: 2112 diff changeset	3942	(item enabled and:[item isVisible]) ifTrue:[
826d48809a17 mnemonic: first test block before enabled and visibility (optimize) ca parents: 2112 diff changeset	3943	isItem ifTrue:[ ^ OrderedCollection with:i ].
826d48809a17 mnemonic: first test block before enabled and visibility (optimize) ca parents: 2112 diff changeset	3944
826d48809a17 mnemonic: first test block before enabled and visibility (optimize) ca parents: 2112 diff changeset	3945	"process submenu"
826d48809a17 mnemonic: first test block before enabled and visibility (optimize) ca parents: 2112 diff changeset	3946	menu := item submenu.
2112 c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3947
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3948	(menu notNil and:[menu isEnabled]) ifTrue:[
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3949	seq := menu selectItemIndicesFor:aOneArgBlock maxDepth:(maxDepth - 1).
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3950	seq notNil ifTrue:[
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3951	seq addFirst:i.
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3952	^ seq
c4cd07f21fac processing mnemonic's (search next from current) ca parents: 2111 diff changeset	3953	]
1878 1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3954	]
1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3955	]
2113 826d48809a17 mnemonic: first test block before enabled and visibility (optimize) ca parents: 2112 diff changeset	3956	].
1878 1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3957	].
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	3958	^ nil
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	3959	! !
1878 1afc5cdf3002 mnemonic-key and shortcut-key support; ca parents: 1877 diff changeset	3960
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3961	!MenuPanel methodsFor:'misc'!
dce33f8bb806 intitial checkin ca parents: diff changeset	3962
427 82cbad72e197 raiseDeiconified is treated like a raise Claus Gittinger <cg@exept.de> parents: 420 diff changeset	3963	raiseDeiconified
82cbad72e197 raiseDeiconified is treated like a raise Claus Gittinger <cg@exept.de> parents: 420 diff changeset	3964	^ self raise
82cbad72e197 raiseDeiconified is treated like a raise Claus Gittinger <cg@exept.de> parents: 420 diff changeset	3965
82cbad72e197 raiseDeiconified is treated like a raise Claus Gittinger <cg@exept.de> parents: 420 diff changeset	3966	"Created: 21.6.1997 / 13:29:12 / cg"
82cbad72e197 raiseDeiconified is treated like a raise Claus Gittinger <cg@exept.de> parents: 420 diff changeset	3967	!
82cbad72e197 raiseDeiconified is treated like a raise Claus Gittinger <cg@exept.de> parents: 420 diff changeset	3968
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3969	superMenu
dce33f8bb806 intitial checkin ca parents: diff changeset	3970	"returns supermenu or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	3971	"
dce33f8bb806 intitial checkin ca parents: diff changeset	3972	^ superMenu
dce33f8bb806 intitial checkin ca parents: diff changeset	3973
dce33f8bb806 intitial checkin ca parents: diff changeset	3974
dce33f8bb806 intitial checkin ca parents: diff changeset	3975	!
dce33f8bb806 intitial checkin ca parents: diff changeset	3976
dce33f8bb806 intitial checkin ca parents: diff changeset	3977	superMenu:aSuperMenu
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	3978	"set my supermenu from which i'am activated
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	3979	"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	3980	(superMenu := aSuperMenu) notNil ifTrue:[
2003 732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	3981	super font:(superMenu font).
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	3982	].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3983	!
dce33f8bb806 intitial checkin ca parents: diff changeset	3984
dce33f8bb806 intitial checkin ca parents: diff changeset	3985	topMenu
dce33f8bb806 intitial checkin ca parents: diff changeset	3986	"returns the topMenu; the one having no superMenu
dce33f8bb806 intitial checkin ca parents: diff changeset	3987	"
1791 bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3988	\|menu smenu\|
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3989
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3990	menu := self.
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3991
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3992	[(smenu := menu superMenu) notNil] whileTrue:[
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3993	menu := smenu
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3994	].
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	3995	^ menu
388 dce33f8bb806 intitial checkin ca parents: diff changeset	3996	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	3997
1825 962390f1b499 category change Claus Gittinger <cg@exept.de> parents: 1824 diff changeset	3998	!MenuPanel methodsFor:'printing & storing'!
798 74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	3999
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4000	printString
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4001	"return a printed representation of the menu
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4002	"
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4003	\|string label\|
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4004
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4005	string := 'Menu:'.
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4006
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4007	self do:[:anItem\|
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	4008	label := anItem label ? ''.
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	4009	string := string ,' ', label printString.
798 74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4010	].
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4011	^ string
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4012
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4013	"Modified: / 27.2.1998 / 17:41:22 / cg"
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4014	! !
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4015
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4016	!MenuPanel methodsFor:'private'!
dce33f8bb806 intitial checkin ca parents: diff changeset	4017
434 9898a2909ef0 add active help for items ca parents: 433 diff changeset	4018	application
1613 5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4019	"optimize access to retrive the application
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4020	"
1921 f3f120d43849 oops - handle query for application, when view is already closed. Claus Gittinger <cg@exept.de> parents: 1919 diff changeset	4021	\|appl akey w views\|
434 9898a2909ef0 add active help for items ca parents: 433 diff changeset	4022
9898a2909ef0 add active help for items ca parents: 433 diff changeset	4023	superMenu notNil ifTrue:[
1613 5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4024	^ superMenu application
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4025	].
1870 ba2f5f6b5005 avoid recursive runaway in #applciation ca parents: 1864 diff changeset	4026
1613 5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4027	akey := #appl.
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4028	appl := self menuAdornmentAt:akey.
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4029
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4030	appl isNil ifTrue:[
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4031	(appl := super application) isNil ifTrue:[
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4032	windowGroup isNil ifTrue:[
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4033	^ nil "/ RETRY LATER
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4034	].
1921 f3f120d43849 oops - handle query for application, when view is already closed. Claus Gittinger <cg@exept.de> parents: 1919 diff changeset	4035	views := windowGroup mainGroup topViews.
f3f120d43849 oops - handle query for application, when view is already closed. Claus Gittinger <cg@exept.de> parents: 1919 diff changeset	4036	views size == 0 ifTrue:[
f3f120d43849 oops - handle query for application, when view is already closed. Claus Gittinger <cg@exept.de> parents: 1919 diff changeset	4037	^ nil "/ RETRY LATER
f3f120d43849 oops - handle query for application, when view is already closed. Claus Gittinger <cg@exept.de> parents: 1919 diff changeset	4038	].
f3f120d43849 oops - handle query for application, when view is already closed. Claus Gittinger <cg@exept.de> parents: 1919 diff changeset	4039	w := views first.
1870 ba2f5f6b5005 avoid recursive runaway in #applciation ca parents: 1864 diff changeset	4040	w == self ifTrue:[
1872 b20e27632fd8 application fetch fix Claus Gittinger <cg@exept.de> parents: 1870 diff changeset	4041	thisContext isRecursive ifTrue:[
b20e27632fd8 application fetch fix Claus Gittinger <cg@exept.de> parents: 1870 diff changeset	4042	self error:'recursive application query'
b20e27632fd8 application fetch fix Claus Gittinger <cg@exept.de> parents: 1870 diff changeset	4043	].
b20e27632fd8 application fetch fix Claus Gittinger <cg@exept.de> parents: 1870 diff changeset	4044	"/ appl := akey
1870 ba2f5f6b5005 avoid recursive runaway in #applciation ca parents: 1864 diff changeset	4045	].
1872 b20e27632fd8 application fetch fix Claus Gittinger <cg@exept.de> parents: 1870 diff changeset	4046	appl := (w application) ? akey.
1613 5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4047	].
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4048	self menuAdornmentAt:akey put:appl
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	4049	].
1872 b20e27632fd8 application fetch fix Claus Gittinger <cg@exept.de> parents: 1870 diff changeset	4050	^ appl ~~ akey ifTrue:[appl] ifFalse:[nil]
b20e27632fd8 application fetch fix Claus Gittinger <cg@exept.de> parents: 1870 diff changeset	4051	!
434 9898a2909ef0 add active help for items ca parents: 433 diff changeset	4052
1572 80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4053	detectItemForKey:aKey
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4054	"returns the item assigned to a key, accessCharacter or starts with.
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4055	if no item is detected nil is returned.
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4056	"
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4057	\|cIdx uKey lKey item\|
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4058
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4059	items isNil ifTrue:[^ nil].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4060
1572 80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4061	cIdx := self selectionIndex.
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4062	uKey := aKey asUppercase.
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4063	lKey := aKey asLowercase.
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4064
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4065	items keysAndValuesDo:[:anIndex :anItem\| \|char label\|
1572 80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4066	( anIndex ~~ cIdx
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4067	and:[anItem canSelect
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4068	and:[(label := anItem textLabel) notNil
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4069	and:[label size ~~ 0]]]
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4070	) ifTrue:[
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4071	(char := anItem accessCharacter) notNil ifTrue:[
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4072	(char == uKey or:[char == lKey]) ifTrue:[
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4073	^ anItem
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4074	]
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4075	] ifFalse:[
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4076	char := label at:1.
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4077
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4078	(char == uKey or:[char == lKey]) ifTrue:[
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4079	anIndex > cIdx ifTrue:[
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4080	^ anItem
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4081	].
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4082	item isNil ifTrue:[item := anItem]
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4083	]
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4084	]
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4085	]
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4086	].
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4087	^ item
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4088	!
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4089
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4090	menuAdornmentAt:aSymbol
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4091	"returns a value derived from adornment
dce33f8bb806 intitial checkin ca parents: diff changeset	4092	"
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4093	\|adm\|
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4094
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4095	adm := adornment ? DefaultAdornment.
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4096	^ adm at:aSymbol ifAbsent:nil
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4097	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4098
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4099	menuAdornmentAt:aSymbol put:something
653 cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	4100	"sets a value for the specific menu; if the value differs to the
cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	4101	current stored value, true is returned otherwise false
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4102	"
653 cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	4103	(self menuAdornmentAt:aSymbol) == something ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	4104	^ false
653 cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	4105	].
cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	4106	adornment isNil ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	4107	adornment := DefaultAdornment copy
653 cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	4108	].
cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	4109	adornment at:aSymbol put:something.
cf9b6ef11ade bug fix; no automatic rearrange of items ca parents: 650 diff changeset	4110	^ true
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4111	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4112
dce33f8bb806 intitial checkin ca parents: diff changeset	4113	onEachPerform:aSelector withArgList:aList
dce33f8bb806 intitial checkin ca parents: diff changeset	4114	"on each item perform selector with an argument derived from aList
dce33f8bb806 intitial checkin ca parents: diff changeset	4115	"
dce33f8bb806 intitial checkin ca parents: diff changeset	4116	aList isCollection ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	4117	items size >= aList size ifTrue:[
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	4118	aList keysAndValuesDo:[:anIndex :anArg\|
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	4119	(items at:anIndex) perform:aSelector with:anArg
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	4120	]
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	4121	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4122	] ifFalse:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	4123	self do:[:anItem\| anItem perform:aSelector with:aList ]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4124	]
dce33f8bb806 intitial checkin ca parents: diff changeset	4125
dce33f8bb806 intitial checkin ca parents: diff changeset	4126
dce33f8bb806 intitial checkin ca parents: diff changeset	4127	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4128
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4129	registerImageOnDevice:anImage
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4130	\|image\|
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4131
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4132	(image := anImage) notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4133	image device ~~ device ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4134	image := image copy.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4135	].
2098 d59707230877 #on: -> #onDevice Claus Gittinger <cg@exept.de> parents: 2096 diff changeset	4136	image := image onDevice:device.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4137	image := image clearMaskedPixels.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4138	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4139	^ image
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4140	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	4141
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4142	!MenuPanel methodsFor:'private-activation'!
687 23ce9888d76f bug fixes: ca parents: 681 diff changeset	4143
798 74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4144	activeMenu
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4145	"returns the current active menu or self (the top menu)
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4146	"
687 23ce9888d76f bug fixes: ca parents: 681 diff changeset	4147	^ lastActiveMenu ? self
23ce9888d76f bug fixes: ca parents: 681 diff changeset	4148
798 74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4149	"Created: / 27.2.1998 / 17:41:15 / cg"
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4150	!
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4151
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4152	activeMenu:aMenu
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4153	"set the current active menu
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4154	"
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4155	lastActiveMenu := aMenu
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4156
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4157	"Created: / 27.2.1998 / 17:41:16 / cg"
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4158	!
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4159
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4160	becomesActiveMenu
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4161	"submenu becomes the active menu
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4162	"
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4163	mapTime := Time millisecondClockValue.
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4164	self topMenu activeMenu:self.
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4165
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4166	"Created: / 27.2.1998 / 17:41:23 / cg"
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4167	!
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4168
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4169	clearLastActiveMenu
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4170	"reset the current active menu
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4171	"
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4172	\|top\|
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4173
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4174	top := self topMenu.
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4175
1612 42e2fce5a1f9 set focus back ca parents: 1610 diff changeset	4176	prevFocusView notNil ifTrue:[
42e2fce5a1f9 set focus back ca parents: 1610 diff changeset	4177	self windowGroup focusView:prevFocusView.
42e2fce5a1f9 set focus back ca parents: 1610 diff changeset	4178	prevFocusView := nil.
42e2fce5a1f9 set focus back ca parents: 1610 diff changeset	4179	].
42e2fce5a1f9 set focus back ca parents: 1610 diff changeset	4180
798 74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4181	top activeMenu == self ifTrue:[
1612 42e2fce5a1f9 set focus back ca parents: 1610 diff changeset	4182	top activeMenu:nil
687 23ce9888d76f bug fixes: ca parents: 681 diff changeset	4183	]
23ce9888d76f bug fixes: ca parents: 681 diff changeset	4184
798 74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4185	"Created: / 27.2.1998 / 17:41:17 / cg"
687 23ce9888d76f bug fixes: ca parents: 681 diff changeset	4186	!
23ce9888d76f bug fixes: ca parents: 681 diff changeset	4187
23ce9888d76f bug fixes: ca parents: 681 diff changeset	4188	mapTime
798 74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4189	"returns the time when the menu becomes active
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4190	"
687 23ce9888d76f bug fixes: ca parents: 681 diff changeset	4191	^ mapTime
798 74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4192
74f4e7b66a46 ca's fixes for mapTime (fast-button-release) Claus Gittinger <cg@exept.de> parents: 794 diff changeset	4193	"Modified: / 27.2.1998 / 17:41:18 / cg"
687 23ce9888d76f bug fixes: ca parents: 681 diff changeset	4194	! !
23ce9888d76f bug fixes: ca parents: 681 diff changeset	4195
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4196	!MenuPanel methodsFor:'private-scrolling'!
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4197
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4198	hasScrollerAt:aDirection
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4199	"returns true if a visible scroller at a direction exists
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4200	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4201	\|layout\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4202
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4203	self hasScrollers ifFalse:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4204	^ false
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4205	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4206
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4207	aDirection == #PREV ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4208	layout := items first layout.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4209
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4210	^ self verticalLayout ifTrue:[ layout top < margin]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4211	ifFalse:[ layout left < margin]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4212	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4213	layout := items last layout.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4214
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4215	^ self verticalLayout ifTrue:[ layout bottom > (height - margin)]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4216	ifFalse:[ layout right > (width - margin)]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4217	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4218
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4219	hasScrollers
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4220	"returns true if scrollers are needed
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4221	"
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4222	\|maxExtent first last isVert\|
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4223
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4224	(mustRearrange or:[items size < 2]) ifTrue:[^ false].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4225
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4226	isVert := self verticalLayout.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4227
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4228	superView notNil ifTrue:[
2039 176da0a9b13c test for empty layouts ca parents: 2024 diff changeset	4229	( (first := items first layout) isNil
176da0a9b13c test for empty layouts ca parents: 2024 diff changeset	4230	or:[(last := items last layout) isNil]
176da0a9b13c test for empty layouts ca parents: 2024 diff changeset	4231	) ifTrue:[
176da0a9b13c test for empty layouts ca parents: 2024 diff changeset	4232	^ false
176da0a9b13c test for empty layouts ca parents: 2024 diff changeset	4233	].
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4234	isVert ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4235	^ first top < 0 or:[last bottom > height]
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4236	].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4237	^ first left < 0 or:[last right > width]
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4238	].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4239	maxExtent := self maxExtent.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4240
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4241	isVert ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4242	^ (height < maxExtent y) not
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4243	].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4244	^ (width < maxExtent x) not
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4245	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4246
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4247	indexOfItemAtScroller:aDirection
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4248	"returns the index of the item under the scroller or 0
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4249	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4250	\|bounds min max layout\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4251
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4252	bounds := self scrollerBoundsAt:aDirection.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4253
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4254	bounds isNil ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4255	^ 0
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4256	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4257
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4258	self verticalLayout ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4259	min := bounds top.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4260	max := bounds bottom.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4261
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4262	items keysAndValuesDo:[:anIndex :anItem\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4263	anItem isVisible ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4264	layout := anItem layout.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4265
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4266	(layout top < max and:[layout bottom > min]) ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4267	^ anIndex
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4268	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4269	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4270	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4271	] ifFalse:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4272	min := bounds left.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4273	max := bounds right.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4274
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4275	items keysAndValuesDo:[:anIndex :anItem\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4276	anItem isVisible ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4277	layout := anItem layout.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4278
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4279	(layout left < max and:[layout right > min]) ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4280	^ anIndex
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4281	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4282	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4283	]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4284	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4285	^ 0
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4286	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4287
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4288	makeItemVisible:anItem
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4289	"make an item visible
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4290	"
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4291	\|boundsPREV boundsNEXT delta layout index scr0 scr1 windowSz scrSz doScroll
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4292	isVertical boundsMin layoutMin boundsMax layoutMax dltOrg
2042 cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4293	inv1 inv2\|
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4294
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4295	( anItem notNil
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4296	and:[self hasScrollers
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4297	and:[(layout := anItem layout) notNil]]
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4298	) ifFalse:[
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4299	^ self
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4300	].
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4301	index := self indexOfItem:anItem.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4302	boundsPREV := self scrollerBoundsAt:#PREV.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4303	boundsNEXT := self scrollerBoundsAt:#NEXT.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4304
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4305	isVertical := self verticalLayout.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4306
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4307	isVertical ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4308	boundsMin := boundsPREV bottom.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4309	boundsMax := boundsNEXT top.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4310	layoutMin := layout top.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4311	layoutMax := layout bottom.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4312	windowSz := height.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4313	] ifFalse:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4314	boundsMin := boundsPREV right.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4315	boundsMax := boundsNEXT left.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4316	layoutMin := layout left.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4317	layoutMax := layout right.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4318	windowSz := width.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4319	].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4320
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4321
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4322	layoutMin < boundsMin ifTrue:[
2062 31ba9af25394 checkin from browser Claus Gittinger <cg@exept.de> parents: 2061 diff changeset	4323	layoutMin >= 0 ifTrue:[
31ba9af25394 checkin from browser Claus Gittinger <cg@exept.de> parents: 2061 diff changeset	4324	^ self
31ba9af25394 checkin from browser Claus Gittinger <cg@exept.de> parents: 2061 diff changeset	4325	].
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4326	"/ test whether is first visible item
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4327	index := items findLast:[:el\| el isVisible] startingAt:(index - 1).
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4328
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4329	index == 0 ifTrue:[ scr0 := margin ]
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4330	ifFalse:[ scr0 := boundsMin ].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4331
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4332	delta := layoutMin negated + scr0.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4333	] ifFalse:[
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4334	layoutMax > boundsMax ifFalse:[
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4335	^ self
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4336	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4337	"/ test whether is last visible item
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4338	index := items findFirst:[:el\| el isVisible ] startingAt:(index + 1).
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4339
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4340	index == 0 ifTrue:[ scr0 := windowSz - margin ]
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4341	ifFalse:[ scr0 := boundsMax ].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4342
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4343	delta := scr0 - layoutMax.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4344	].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4345	delta == 0 ifTrue:[ ^ self ].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4346
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4347	doScroll := false.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4348
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4349	shown ifTrue:[
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4350	delta abs < (windowSz / 2) ifTrue:[
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4351	doScroll := true.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4352	self repairDamage
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4353	]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4354	].
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4355	isVertical ifTrue:[ dltOrg := 0@delta ] ifFalse:[dltOrg := delta@0].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4356	items do:[:el\| el moveBy:dltOrg ].
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4357
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4358	doScroll ifFalse:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4359	^ self invalidate
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4360	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4361
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4362	windowSz := windowSz - margin - margin.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4363
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4364	scr0 := boundsMin.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4365	scr1 := scr0 + delta abs.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4366	scrSz := boundsMax - scr1.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4367
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4368	delta < 0 ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4369	isVertical ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4370	self copyFrom:self x:margin y:scr1 toX:margin y:scr0
2041 00e511a396d0 either invoke catchExpose or do not copy async. Claus Gittinger <cg@exept.de> parents: 2039 diff changeset	4371	width:windowSz height:scrSz async:false.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4372
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4373	scr1 := scr0 + scrSz.
2042 cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4374	inv2 := (margin @ scr1) extent:(windowSz @ (height - scr1 - margin)).
cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4375	"/ self invalidateX:margin y:scr1 width:windowSz height:(height - scr1 - margin).
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4376	] ifFalse:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4377	self copyFrom:self x:scr1 y:margin toX:scr0 y:margin
2041 00e511a396d0 either invoke catchExpose or do not copy async. Claus Gittinger <cg@exept.de> parents: 2039 diff changeset	4378	width:scrSz height:windowSz async:false.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4379
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4380	scr1 := scr0 + scrSz.
2042 cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4381	inv2 := (scr1 @ margin) extent:((width - scr1 - margin) @ windowSz).
cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4382	"/ self invalidateX:scr1 y:margin width:(width - scr1 - margin) height:windowSz.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4383	].
2042 cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4384	inv1 := boundsPREV.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4385	] ifFalse:[
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4386	isVertical ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4387	self copyFrom:self x:margin y:scr0 toX:margin y:scr1
2041 00e511a396d0 either invoke catchExpose or do not copy async. Claus Gittinger <cg@exept.de> parents: 2039 diff changeset	4388	width:windowSz height:scrSz async:false.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4389
2042 cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4390	inv2 := (margin @ margin) extent:(windowSz @ (scr1 - margin)).
cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4391	"/ self invalidateX:margin y:margin width:windowSz height:scr1 - margin.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4392	] ifFalse:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4393	self copyFrom:self x:scr0 y:margin toX:scr1 y:margin
2041 00e511a396d0 either invoke catchExpose or do not copy async. Claus Gittinger <cg@exept.de> parents: 2039 diff changeset	4394	width:scrSz height:windowSz async:false.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4395
2042 cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4396	inv2 := (margin @ margin) extent:(scr1 - margin) @ windowSz.
cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4397	"/ self invalidateX:margin y:margin width:scr1 - margin height:windowSz.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	4398	].
2042 cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4399	inv1 := boundsNEXT.
cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4400	].
cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4401	self invalidate:inv1.
cc2141b4117f checkin from browser Claus Gittinger <cg@exept.de> parents: 2041 diff changeset	4402	self invalidate:inv2.
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	4403
ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	4404	"Modified: / 13.11.2001 / 20:26:42 / cg"
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4405	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4406
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4407	scrollActivity
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4408	"returns the one and only scrollActivity - data holder
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4409	for a menu and all contained submenus
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4410	"
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4411	superMenu notNil ifTrue:[
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4412	^ superMenu scrollActivity
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4413	].
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4414	scrollActivity isNil ifTrue:[
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4415	scrollActivity := ScrollActivity new.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4416	].
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4417	^ scrollActivity
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4418	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4419
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4420	scrollerBoundsAt:aDirection
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4421	"returns the bounds of the scroller at a direction or nil
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4422	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4423	\|y x w h inset\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4424
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4425	self hasScrollers ifFalse:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4426	^ nil
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4427	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4428	inset := 0.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4429	x := y := inset.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4430	w := h := 15.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4431
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4432	self verticalLayout ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4433	aDirection == #NEXT ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4434	y := height - h - inset.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4435	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4436	w := width - inset - inset.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4437	] ifFalse:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4438	aDirection == #NEXT ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4439	x := width - w - inset.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4440	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4441	h := height - inset - inset.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4442	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4443	^ Rectangle left:x top:y width:w height:h
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4444	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4445
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4446	scrollerDirectionAtPoint:aPoint
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4447	"returns the scroller-direction at aPoint, or nil
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4448	"
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4449	self hasScrollers ifTrue:[
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4450	#( PREV NEXT ) do:[:aDirection\| \|bounds\|
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4451	( (bounds := self scrollerBoundsAt:aDirection) notNil
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4452	and:[bounds containsPoint:aPoint]
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4453	) ifTrue:[
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4454	^ (self hasScrollerAt:aDirection) ifTrue:[aDirection] ifFalse:[nil]
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4455	]
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4456	]
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4457	].
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4458	^ nil
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4459
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4460	"Created: / 13.11.2001 / 14:13:16 / cg"
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4461	! !
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4462
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4463	!MenuPanel methodsFor:'private-searching'!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4464
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4465	detectGrabMenu
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4466	"returns the menu which is responsible for the grap; the last opened menu
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4467	"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4468	\|subMenu\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4469
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4470	selection notNil ifTrue:[
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	4471	(subMenu := selection visibleSubmenu) notNil ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4472	^ subMenu detectGrabMenu
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4473	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4474	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4475	^ self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4476	!
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4477
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4478	detectMenuAtGrabPoint:aGrabPoint
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4479	"returns the menu which contains the grab-point
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4480	"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4481	\|dstMenu dstPoint firstMenu\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4482
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4483	dstPoint := self translateGrabPoint:aGrabPoint.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4484
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4485	((dstPoint x between:0 and:width) and:[dstPoint y between:0 and:height]) ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4486	firstMenu := self.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4487	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4488
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	4489	(selection isNil or:[(dstMenu := selection visibleSubmenu) isNil]) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4490	^ firstMenu
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4491	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4492	dstMenu := dstMenu detectMenuAtGrabPoint:aGrabPoint.
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	4493	^ dstMenu ? firstMenu
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4494	!
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4495
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	4496	detectViewAtX:x y:y in:aTopView
1922 1a2ab52eb2ab bug fix in #detectViewAtX:y:in: ca parents: 1921 diff changeset	4497	"detect view at x@y
1a2ab52eb2ab bug fix in #detectViewAtX:y:in: ca parents: 1921 diff changeset	4498	"
2020 1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4499	^ aTopView detectViewAt:(x@y).
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4500
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4501	"/ cg: old code was (refactored to use common code)
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4502	"/
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4503	"/ \|p subViews\|
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4504	"/
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4505	"/ (subViews := aTopView subViews) notNil ifTrue:[
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4506	"/ subViews do:[:v\| \|p\|
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4507	"/ v shown ifTrue:[
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4508	"/ ( (x between:(v left) and:(v right))
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4509	"/ and:[y between:(v top) and:(v bottom)]
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4510	"/ ) ifTrue:[
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4511	"/ p := device translatePoint:(x@y) from:(aTopView id) to:(v id).
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4512	"/ ^ self detectViewAtX:p x y:p y in:v.
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4513	"/ ]
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4514	"/ ]
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4515	"/ ]
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4516	"/ ].
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4517	"/ ^ aTopView
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4518
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4519	"Modified: / 10.10.2001 / 13:45:56 / cg"
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	4520	!
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	4521
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4522	itemAtPoint:aPoint
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4523	"returns the item at a point x@y or nil if none detected
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4524	"
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4525	items notNil ifTrue:[
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4526	^ items detect:[:el\| el containsPoint:aPoint] ifNone:nil
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4527	].
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4528	^ nil
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4529
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4530	"Created: / 13.11.2001 / 13:58:23 / cg"
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4531	!
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	4532
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4533	itemAtX:x y:y
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4534	"returns the item at a point x@y or nil if none detected
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4535	"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4536	items notNil ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4537	^ items detect:[:el\| el containsPointX:x y:y] ifNone:nil
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4538	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4539	^ nil
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4540	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4541
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	4542	superMenuAtPoint:aPoint
ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	4543	"returns the superMenu which contains aPoint, or nil if none detected
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4544	"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4545	\|grabPoint superMenu\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4546
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	4547	(self containsPoint:aPoint) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4548	^ self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4549	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4550
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	4551	grabPoint := aPoint - (self translateGrabPoint:0).
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4552	superMenu := self.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4553
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4554	[ (superMenu := superMenu superMenu) notNil ] whileTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4555	(superMenu containsPoint:(superMenu translateGrabPoint:grabPoint)) ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4556	^ superMenu
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4557	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4558	].
dce33f8bb806 intitial checkin ca parents: diff changeset	4559	^ nil
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4560
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	4561	"Created: / 13.11.2001 / 20:22:53 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4562	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	4563
dce33f8bb806 intitial checkin ca parents: diff changeset	4564	!MenuPanel methodsFor:'queries'!
dce33f8bb806 intitial checkin ca parents: diff changeset	4565
2003 732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	4566	container:aView
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	4567	super container:aView.
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	4568	aView notNil ifTrue:[
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	4569	"/ I am no longer a popUpView
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	4570	self updateLevelAndBorder
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	4571	].
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	4572	!
732fbaf5864f avoid changing the level after realization (to avoid confusing the shadow) Claus Gittinger <cg@exept.de> parents: 2000 diff changeset	4573
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4574	containsPoint:aPoint
dce33f8bb806 intitial checkin ca parents: diff changeset	4575	"returns true if point is contained by the view
dce33f8bb806 intitial checkin ca parents: diff changeset	4576	"
dce33f8bb806 intitial checkin ca parents: diff changeset	4577	^ self containsPointX:(aPoint x) y:(aPoint y)
dce33f8bb806 intitial checkin ca parents: diff changeset	4578	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4579
dce33f8bb806 intitial checkin ca parents: diff changeset	4580	containsPointX:x y:y
dce33f8bb806 intitial checkin ca parents: diff changeset	4581	"returns true if point is contained by the view
dce33f8bb806 intitial checkin ca parents: diff changeset	4582	"
708 245b1aa06151 checkin from browser Claus Gittinger <cg@exept.de> parents: 706 diff changeset	4583	^ (x between:0 and:width) and:[y between:0 and:height]
879 837cee20fdcb * empty log message * Claus Gittinger <cg@exept.de> parents: 878 diff changeset	4584
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4585	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4586
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4587	hasGroupDividerAt:anIndex
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4588	"returns true if a divider is defined at an index
dce33f8bb806 intitial checkin ca parents: diff changeset	4589	"
dce33f8bb806 intitial checkin ca parents: diff changeset	4590	\|i\|
dce33f8bb806 intitial checkin ca parents: diff changeset	4591
dce33f8bb806 intitial checkin ca parents: diff changeset	4592	groupSizes size ~~ 0 ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4593	i := 0.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4594
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4595	groupSizes do:[:t\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4596	(i := i + t) == anIndex ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4597	^ true
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4598	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4599	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4600	].
dce33f8bb806 intitial checkin ca parents: diff changeset	4601	^ false
dce33f8bb806 intitial checkin ca parents: diff changeset	4602
dce33f8bb806 intitial checkin ca parents: diff changeset	4603	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4604
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4605	hasGroupDividers
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4606	"returns true if any group divider exists
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4607	"
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4608	^ (items size ~~ 0 and:[groupSizes size ~~ 0])
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4609	!
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4610
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4611	isEnabled
dce33f8bb806 intitial checkin ca parents: diff changeset	4612	"returns enabled state of menu and items
dce33f8bb806 intitial checkin ca parents: diff changeset	4613	"
dce33f8bb806 intitial checkin ca parents: diff changeset	4614	^ self enabled
dce33f8bb806 intitial checkin ca parents: diff changeset	4615	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4616
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4617	isFitPanel
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4618	"returns true if the panel is the first in the menu hierarchy in must
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4619	be fit to the extent of its superView;
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4620	NOT SUPPORTED
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4621	"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4622	^ false
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4623	!
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4624
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4625	isPopUpView
dce33f8bb806 intitial checkin ca parents: diff changeset	4626	"return true if view is a popup view; without decoration
dce33f8bb806 intitial checkin ca parents: diff changeset	4627	and popUp to top immediately
dce33f8bb806 intitial checkin ca parents: diff changeset	4628	"
dce33f8bb806 intitial checkin ca parents: diff changeset	4629	^ superView isNil
dce33f8bb806 intitial checkin ca parents: diff changeset	4630
dce33f8bb806 intitial checkin ca parents: diff changeset	4631
dce33f8bb806 intitial checkin ca parents: diff changeset	4632	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4633
dce33f8bb806 intitial checkin ca parents: diff changeset	4634	isVerticalLayout
dce33f8bb806 intitial checkin ca parents: diff changeset	4635	"returns true if vertical layout otherwise false( horizontal layout )
dce33f8bb806 intitial checkin ca parents: diff changeset	4636	"
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4637	^ self verticalLayout
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4638
dce33f8bb806 intitial checkin ca parents: diff changeset	4639
416 c05874084d4c implement ca parents: 407 diff changeset	4640	!
c05874084d4c implement ca parents: 407 diff changeset	4641
1793 f76529768dd6 keyPress:... check for wrapped view ca parents: 1791 diff changeset	4642	isViewWrapper
f76529768dd6 keyPress:... check for wrapped view ca parents: 1791 diff changeset	4643	^ subViews size ~~ 0
f76529768dd6 keyPress:... check for wrapped view ca parents: 1791 diff changeset	4644	!
f76529768dd6 keyPress:... check for wrapped view ca parents: 1791 diff changeset	4645
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	4646	openMenuOnSelect
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	4647	^ (self menuAdornmentAt:#openMenuOnSelect) ? DefaultOpenOnSelect.
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	4648
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	4649	!
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	4650
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	4651	openMenuOnSelect:something
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	4652	^ self menuAdornmentAt:#openMenuOnSelect put:something
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	4653	!
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	4654
2061 faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	4655	select:newSel openMenu:openMenu
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	4656	\|old\|
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	4657
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	4658	old := self menuAdornmentAt:#openMenuOnSelect.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	4659	self menuAdornmentAt:#openMenuOnSelect put:openMenu.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	4660	self selection:newSel.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	4661	self menuAdornmentAt:#openMenuOnSelect put:old.
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	4662	!
faf64f2cd28e * empty log message * Claus Gittinger <cg@exept.de> parents: 2059 diff changeset	4663
416 c05874084d4c implement ca parents: 407 diff changeset	4664	type
428 5cf5fb7ecf39 type ca parents: 427 diff changeset	4665	^ nil.
416 c05874084d4c implement ca parents: 407 diff changeset	4666
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4667	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	4668
dce33f8bb806 intitial checkin ca parents: diff changeset	4669	!MenuPanel methodsFor:'selection'!
dce33f8bb806 intitial checkin ca parents: diff changeset	4670
dce33f8bb806 intitial checkin ca parents: diff changeset	4671	hasSelection
dce33f8bb806 intitial checkin ca parents: diff changeset	4672	"returns true if a selection exists
dce33f8bb806 intitial checkin ca parents: diff changeset	4673	"
dce33f8bb806 intitial checkin ca parents: diff changeset	4674	^ self selection notNil
dce33f8bb806 intitial checkin ca parents: diff changeset	4675	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4676
dce33f8bb806 intitial checkin ca parents: diff changeset	4677	selection
dce33f8bb806 intitial checkin ca parents: diff changeset	4678	"returns current selected item or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	4679	"
dce33f8bb806 intitial checkin ca parents: diff changeset	4680	^ selection
dce33f8bb806 intitial checkin ca parents: diff changeset	4681
dce33f8bb806 intitial checkin ca parents: diff changeset	4682
dce33f8bb806 intitial checkin ca parents: diff changeset	4683	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4684
dce33f8bb806 intitial checkin ca parents: diff changeset	4685	selection:anItemOrNil
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4686	"change selection to an item or nil
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4687	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4688	\|item newSel hlp visItem\|
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4689
1572 80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4690	(newSel := anItemOrNil) isNumber ifTrue:[
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4691	newSel := self itemAt:anItemOrNil
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4692	].
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4693	visItem := newSel.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4694
1572 80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4695	(newSel notNil and:[newSel canSelect]) ifFalse:[
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4696	newSel := nil
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4697	].
dce33f8bb806 intitial checkin ca parents: diff changeset	4698
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4699	selection == newSel ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4700	^ self
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4701	].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4702
dce33f8bb806 intitial checkin ca parents: diff changeset	4703	(item := selection) notNil ifTrue:[
1572 80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4704	selection := nil.
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	4705	item selected:false.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4706	].
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	4707	visItem notNil ifTrue:[self makeItemVisible:visItem].
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4708
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4709	newSel isNil ifTrue:[^ self].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4710
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4711	newSel == enteredItem ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4712	enteredItem := nil
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4713	] ifFalse:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4714	self pointerEntersItem:nil
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4715	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4716	selection := newSel.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4717
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4718	ActiveHelp isActive ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4719	hlp := ActiveHelp currentHelpListener.
2058 f0a23f80454e flyByHelp Claus Gittinger <cg@exept.de> parents: 2052 diff changeset	4720	hlp initiateHelpFor:self at:nil now:true.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4721	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4722	shown "realized" ifTrue:[self rearrangeItems].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	4723	selection selected:true.
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	4724
ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	4725	"Modified: / 13.11.2001 / 20:17:47 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4726	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4727
dce33f8bb806 intitial checkin ca parents: diff changeset	4728	selectionIndex
dce33f8bb806 intitial checkin ca parents: diff changeset	4729	"returns index of current selection or 0
dce33f8bb806 intitial checkin ca parents: diff changeset	4730	"
dce33f8bb806 intitial checkin ca parents: diff changeset	4731	\|item\|
dce33f8bb806 intitial checkin ca parents: diff changeset	4732
dce33f8bb806 intitial checkin ca parents: diff changeset	4733	(item := self selection) notNil ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	4734	^ self findFirst:[:el\| el == item ]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4735	].
dce33f8bb806 intitial checkin ca parents: diff changeset	4736	^ 0
dce33f8bb806 intitial checkin ca parents: diff changeset	4737
dce33f8bb806 intitial checkin ca parents: diff changeset	4738	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4739
dce33f8bb806 intitial checkin ca parents: diff changeset	4740	selectionIndex:anIndex
dce33f8bb806 intitial checkin ca parents: diff changeset	4741	"set selection at an index
dce33f8bb806 intitial checkin ca parents: diff changeset	4742	"
dce33f8bb806 intitial checkin ca parents: diff changeset	4743	self selection:(self itemAt:anIndex)
dce33f8bb806 intitial checkin ca parents: diff changeset	4744	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	4745
1791 bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4746	!MenuPanel methodsFor:'translation'!
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4747
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4748	translateGrabPoint:aGrabPoint
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4749	"translate the grab point into self
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4750	"
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4751	superMenu isNil ifTrue:[
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4752	"I am the grapView"
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4753	aGrabPoint isNumber ifTrue:[^ aGrabPoint @ aGrabPoint].
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4754	^ aGrabPoint
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4755	].
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4756
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4757	relativeGrabOrigin isNil ifTrue:[
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4758	relativeGrabOrigin := self topMenu translatePoint:0 to:self.
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4759	].
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4760	^ relativeGrabOrigin + aGrabPoint
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4761
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4762	!
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4763
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4764	translateMenuPoint:aPoint toMenu:aMenu
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4765	"translate a point into another menu its point
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4766	"
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4767	\|grapPoint\|
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4768
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4769	aMenu == self ifTrue:[
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4770	^ aPoint
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4771	].
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4772	grapPoint := aPoint - (self translateGrabPoint:0).
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4773
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4774	^ aMenu translateGrabPoint:grapPoint
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4775
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4776	!
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4777
2020 1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4778	translatePoint:aPoint to:anotherWindowOrNilForScreen
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4779	"translate a point in my window to anotherWindowOrNilForScreen (or root window if nil)
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4780	"
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4781
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4782	^ device
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4783	translatePoint:aPoint asPoint
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4784	fromView:self
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4785	toView:anotherWindowOrNilForScreen
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4786
1f1868eba475 extracted common code to detectViewAt:aPoint. Claus Gittinger <cg@exept.de> parents: 2018 diff changeset	4787	"Modified: / 10.10.2001 / 14:11:47 / cg"
1791 bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4788	! !
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	4789
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4790	!MenuPanel::Item class methodsFor:'accessing'!
dce33f8bb806 intitial checkin ca parents: diff changeset	4791
689 aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	4792	horizontalInset
aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	4793	^ HorizontalInset
aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	4794	!
aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	4795
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4796	labelRightOffset
dce33f8bb806 intitial checkin ca parents: diff changeset	4797	^ LabelRightOffset
dce33f8bb806 intitial checkin ca parents: diff changeset	4798	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4799
689 aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	4800	verticalInset
aa13913add84 clear lastActiveMenu when closed ca parents: 687 diff changeset	4801	^ VerticalInset
1765 a003f417d6ad fix for vertical spacing Claus Gittinger <cg@exept.de> parents: 1762 diff changeset	4802	!
a003f417d6ad fix for vertical spacing Claus Gittinger <cg@exept.de> parents: 1762 diff changeset	4803
a003f417d6ad fix for vertical spacing Claus Gittinger <cg@exept.de> parents: 1762 diff changeset	4804	verticalPopUpInset
a003f417d6ad fix for vertical spacing Claus Gittinger <cg@exept.de> parents: 1762 diff changeset	4805	^ VerticalPopUpInset
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4806	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	4807
616 a6157b083830 support of different styles ca parents: 608 diff changeset	4808	!MenuPanel::Item class methodsFor:'defaults'!
a6157b083830 support of different styles ca parents: 608 diff changeset	4809
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4810	halfSeparatorSize
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4811	"returns size of a space-separator
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4812	"
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4813	^ 5
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4814	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	4815
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4816	separatorSize
616 a6157b083830 support of different styles ca parents: 608 diff changeset	4817	"returns size of a separator
a6157b083830 support of different styles ca parents: 608 diff changeset	4818	"
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4819	^ 10
616 a6157b083830 support of different styles ca parents: 608 diff changeset	4820	!
a6157b083830 support of different styles ca parents: 608 diff changeset	4821
a6157b083830 support of different styles ca parents: 608 diff changeset	4822	updateStyleCache
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4823	"setup defaults
650 29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	4824	self updateStyleCache
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4825	"
1765 a003f417d6ad fix for vertical spacing Claus Gittinger <cg@exept.de> parents: 1762 diff changeset	4826	<resource: #style (#'menuPanel.verticalInset')>
a003f417d6ad fix for vertical spacing Claus Gittinger <cg@exept.de> parents: 1762 diff changeset	4827
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4828	HorizontalInset := 2.
1765 a003f417d6ad fix for vertical spacing Claus Gittinger <cg@exept.de> parents: 1762 diff changeset	4829	VerticalInset := MenuPanel styleSheet at:#'menuPanel.verticalInset' default:2.
a003f417d6ad fix for vertical spacing Claus Gittinger <cg@exept.de> parents: 1762 diff changeset	4830	VerticalPopUpInset := 2.
727 3ba54333342a button style from style sheet tz parents: 723 diff changeset	4831
3ba54333342a button style from style sheet tz parents: 723 diff changeset	4832	HorizontalButtonInset := 3.
3ba54333342a button style from style sheet tz parents: 723 diff changeset	4833	VerticalButtonInset := 3.
3ba54333342a button style from style sheet tz parents: 723 diff changeset	4834
681 62c7cdaca188 extra default inset values for button behaviour added tz parents: 680 diff changeset	4835	LabelRightOffset := 15.
1765 a003f417d6ad fix for vertical spacing Claus Gittinger <cg@exept.de> parents: 1762 diff changeset	4836
a003f417d6ad fix for vertical spacing Claus Gittinger <cg@exept.de> parents: 1762 diff changeset	4837
1124 4a7fec62a572 smaller checkbox. Claus Gittinger <cg@exept.de> parents: 1117 diff changeset	4838	! !
1078 3adf74275ebd support choice for buttons ca parents: 1076 diff changeset	4839
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4840	!MenuPanel::Item class methodsFor:'instance creation'!
dce33f8bb806 intitial checkin ca parents: diff changeset	4841
dce33f8bb806 intitial checkin ca parents: diff changeset	4842	in:aSuperMenu
dce33f8bb806 intitial checkin ca parents: diff changeset	4843	^ self in:aSuperMenu label:nil
dce33f8bb806 intitial checkin ca parents: diff changeset	4844	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4845
dce33f8bb806 intitial checkin ca parents: diff changeset	4846	in:aSuperMenu label:aLabel
dce33f8bb806 intitial checkin ca parents: diff changeset	4847	\|item\|
dce33f8bb806 intitial checkin ca parents: diff changeset	4848
dce33f8bb806 intitial checkin ca parents: diff changeset	4849	item := self new in:aSuperMenu.
dce33f8bb806 intitial checkin ca parents: diff changeset	4850	item label:aLabel.
dce33f8bb806 intitial checkin ca parents: diff changeset	4851	^ item
dce33f8bb806 intitial checkin ca parents: diff changeset	4852	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4853
dce33f8bb806 intitial checkin ca parents: diff changeset	4854	in:aSuperMenu menuItem:aMenuItem
dce33f8bb806 intitial checkin ca parents: diff changeset	4855	\|item\|
dce33f8bb806 intitial checkin ca parents: diff changeset	4856
dce33f8bb806 intitial checkin ca parents: diff changeset	4857	item := self in:aSuperMenu.
dce33f8bb806 intitial checkin ca parents: diff changeset	4858	item menuItem:aMenuItem.
dce33f8bb806 intitial checkin ca parents: diff changeset	4859	^ item.
dce33f8bb806 intitial checkin ca parents: diff changeset	4860	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	4861
1808 e8628b502a49 methodCategory change Claus Gittinger <cg@exept.de> parents: 1806 diff changeset	4862	!MenuPanel::Item methodsFor:'accepting'!
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	4863
420 b6f9fff472ef fixes ca parents: 417 diff changeset	4864	canAccept
b6f9fff472ef fixes ca parents: 417 diff changeset	4865	"returns true if item is acceptable
b6f9fff472ef fixes ca parents: 417 diff changeset	4866	"
b6f9fff472ef fixes ca parents: 417 diff changeset	4867	^ (self enabled and:[self hasSubmenu not])
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	4868	!
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	4869
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	4870	toggleIndication
1074 25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	4871	"toggle indication or choice
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	4872	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4873	\|arg\|
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4874
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4875	indication notNil ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4876	arg := self indicationValue not.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4877	self indicationValue:arg.
1074 25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	4878	] ifFalse:[
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4879	choice notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4880	choice value:choiceValue.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4881	^ true
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	4882	]
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	4883	].
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	4884	^ arg
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	4885	! !
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	4886
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4887	!MenuPanel::Item methodsFor:'accessing'!
dce33f8bb806 intitial checkin ca parents: diff changeset	4888
dce33f8bb806 intitial checkin ca parents: diff changeset	4889	accessCharacter
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	4890	"returns my accessCharacter or nil
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4891	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4892	^ accessCharacter
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4893	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4894
dce33f8bb806 intitial checkin ca parents: diff changeset	4895	accessCharacterPosition
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4896	"get the access character position or nil
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4897	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4898	^ accessCharacterPosition
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4899	!
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4900
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4901	accessCharacterPosition:anIndex
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	4902	"set the access character position or nil
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4903	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4904	accessCharacterPosition := anIndex.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4905	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4906
dce33f8bb806 intitial checkin ca parents: diff changeset	4907	argument
dce33f8bb806 intitial checkin ca parents: diff changeset	4908	"gets the argument
dce33f8bb806 intitial checkin ca parents: diff changeset	4909	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4910	^ argument
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4911	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4912
dce33f8bb806 intitial checkin ca parents: diff changeset	4913	argument:anArgument
dce33f8bb806 intitial checkin ca parents: diff changeset	4914	"sets the argument
dce33f8bb806 intitial checkin ca parents: diff changeset	4915	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4916	argument := anArgument.
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	4917	!
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	4918
1727 a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4919	font
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4920	"returns the user configured font or nil (default menu font)
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4921	"
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4922	^ font
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4923	!
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4924
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4925	font:aFont
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4926	"returns the user configured font or nil (default menu font)
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4927	"
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4928	aFont ~= font ifTrue:[
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4929	font := aFont notNil ifTrue:[aFont onDevice:(menuPanel device)]
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4930	ifFalse:[nil].
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4931
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4932	rawLabel notNil ifTrue:[
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4933	"have to recompute the extent"
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4934	self label:label
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4935	]
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4936	].
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4937	!
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4938
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4939	label
dce33f8bb806 intitial checkin ca parents: diff changeset	4940	"returns the label
dce33f8bb806 intitial checkin ca parents: diff changeset	4941	"
dce33f8bb806 intitial checkin ca parents: diff changeset	4942	^ label
dce33f8bb806 intitial checkin ca parents: diff changeset	4943	!
dce33f8bb806 intitial checkin ca parents: diff changeset	4944
dce33f8bb806 intitial checkin ca parents: diff changeset	4945	label:aLabel
399 d083b1bce58d ST-80 compatibility ca parents: 396 diff changeset	4946	"set a new label; if the label changed, a redraw is performed;
d083b1bce58d ST-80 compatibility ca parents: 396 diff changeset	4947	handle characters $& (ST-80 compatibility)
388 dce33f8bb806 intitial checkin ca parents: diff changeset	4948	"
1978 a53447b8cbe2 set label; reange menu if extent changed otherwise redraw only the item martin parents: 1955 diff changeset	4949	\|size char lbl mfont f oldExtent
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4950	h "{ Class:SmallInteger }"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4951	w "{ Class:SmallInteger }"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4952	\|
1978 a53447b8cbe2 set label; reange menu if extent changed otherwise redraw only the item martin parents: 1955 diff changeset	4953	oldExtent := rawLabelExtent.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4954	accessCharacter := rawLabelExtent := disabledRawLabel := nil.
1978 a53447b8cbe2 set label; reange menu if extent changed otherwise redraw only the item martin parents: 1955 diff changeset	4955	label := aLabel value.
a53447b8cbe2 set label; reange menu if extent changed otherwise redraw only the item martin parents: 1955 diff changeset	4956	rawLabel := label value ? ''.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4957
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4958	rawLabel isString ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4959	"CHECK FOR SEPARATOR"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4960
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4961	(isButton not and:[indication isNil and:[choice isNil]]) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4962	size := rawLabel size.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4963
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4964	size == 0 ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4965	rawLabel := nil. "blank separator"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4966	^ self
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4967	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4968
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4969	size == 1 ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4970	char := rawLabel first.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4971
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4972	(char == $- or:[char == $=]) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4973	label := rawLabel. "line separator"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4974	rawLabel := nil.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4975	^ self
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4976	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4977	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4978	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4979	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4980	rawLabel isCollection ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4981	rawLabel := rawLabel asArray.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4982	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4983	].
1727 a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4984	mfont := menuPanel setFont:font.
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	4985
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4986	rawLabel isArray ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4987	w := h := 0.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4988
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4989	rawLabel keysAndValuesDo:[:i :el\|
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4990	el notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4991	lbl := self updateAccessCharacterFor:el.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4992	rawLabel at:i put:lbl.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4993	w := w max:(lbl widthOn:menuPanel).
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4994	h := h + 1 + (lbl heightOn:menuPanel).
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4995	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4996	h := h + 3
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4997	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4998	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	4999	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5000	rawLabel := self updateAccessCharacterFor:rawLabel.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5001	w := rawLabel widthOn:menuPanel.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5002	h := rawLabel heightOn:menuPanel.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5003	].
1797 28327a68241b give a few more pixels at the right if the used font is Claus Gittinger <cg@exept.de> parents: 1796 diff changeset	5004
28327a68241b give a few more pixels at the right if the used font is Claus Gittinger <cg@exept.de> parents: 1796 diff changeset	5005	"/ care for italic fonts - give a few more pixels at the end
28327a68241b give a few more pixels at the right if the used font is Claus Gittinger <cg@exept.de> parents: 1796 diff changeset	5006	f := mfont ? (menuPanel font).
28327a68241b give a few more pixels at the right if the used font is Claus Gittinger <cg@exept.de> parents: 1796 diff changeset	5007	(f notNil and:[f italic]) ifTrue:[
28327a68241b give a few more pixels at the right if the used font is Claus Gittinger <cg@exept.de> parents: 1796 diff changeset	5008	w := w + 2.
28327a68241b give a few more pixels at the right if the used font is Claus Gittinger <cg@exept.de> parents: 1796 diff changeset	5009	].
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5010	rawLabelExtent := w@h.
1978 a53447b8cbe2 set label; reange menu if extent changed otherwise redraw only the item martin parents: 1955 diff changeset	5011
1727 a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	5012	menuPanel setFont:mfont.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5013	menuPanel shown ifTrue:[ self fetchImages ].
1978 a53447b8cbe2 set label; reange menu if extent changed otherwise redraw only the item martin parents: 1955 diff changeset	5014
a53447b8cbe2 set label; reange menu if extent changed otherwise redraw only the item martin parents: 1955 diff changeset	5015	oldExtent = rawLabelExtent ifTrue:[
a53447b8cbe2 set label; reange menu if extent changed otherwise redraw only the item martin parents: 1955 diff changeset	5016	self invalidate
a53447b8cbe2 set label; reange menu if extent changed otherwise redraw only the item martin parents: 1955 diff changeset	5017	] ifFalse:[
a53447b8cbe2 set label; reange menu if extent changed otherwise redraw only the item martin parents: 1955 diff changeset	5018	menuPanel mustRearrange
a53447b8cbe2 set label; reange menu if extent changed otherwise redraw only the item martin parents: 1955 diff changeset	5019	].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5020	!
dce33f8bb806 intitial checkin ca parents: diff changeset	5021
dce33f8bb806 intitial checkin ca parents: diff changeset	5022	menuPanel
dce33f8bb806 intitial checkin ca parents: diff changeset	5023	"returns my menuPanel
dce33f8bb806 intitial checkin ca parents: diff changeset	5024	"
399 d083b1bce58d ST-80 compatibility ca parents: 396 diff changeset	5025	^ menuPanel
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5026	!
dce33f8bb806 intitial checkin ca parents: diff changeset	5027
dce33f8bb806 intitial checkin ca parents: diff changeset	5028	nameKey
dce33f8bb806 intitial checkin ca parents: diff changeset	5029	"gets the nameKey
dce33f8bb806 intitial checkin ca parents: diff changeset	5030	"
dce33f8bb806 intitial checkin ca parents: diff changeset	5031	^ nameKey
dce33f8bb806 intitial checkin ca parents: diff changeset	5032	!
dce33f8bb806 intitial checkin ca parents: diff changeset	5033
dce33f8bb806 intitial checkin ca parents: diff changeset	5034	nameKey:aNameKey
dce33f8bb806 intitial checkin ca parents: diff changeset	5035	"sets the nameKey
dce33f8bb806 intitial checkin ca parents: diff changeset	5036	"
dce33f8bb806 intitial checkin ca parents: diff changeset	5037	nameKey := aNameKey.
dce33f8bb806 intitial checkin ca parents: diff changeset	5038	!
dce33f8bb806 intitial checkin ca parents: diff changeset	5039
dce33f8bb806 intitial checkin ca parents: diff changeset	5040	rawLabel
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5041	"returns my printable Label
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5042	"
dce33f8bb806 intitial checkin ca parents: diff changeset	5043	^ rawLabel
dce33f8bb806 intitial checkin ca parents: diff changeset	5044	!
dce33f8bb806 intitial checkin ca parents: diff changeset	5045
dce33f8bb806 intitial checkin ca parents: diff changeset	5046	shortcutKey
dce33f8bb806 intitial checkin ca parents: diff changeset	5047	"get the key to press to select the submenu from the keyboard or if
dce33f8bb806 intitial checkin ca parents: diff changeset	5048	no submenu exists evaluate the action assigned to the item (accept).
dce33f8bb806 intitial checkin ca parents: diff changeset	5049	"
1609 2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	5050	^ shortcutKey
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5051	!
dce33f8bb806 intitial checkin ca parents: diff changeset	5052
dce33f8bb806 intitial checkin ca parents: diff changeset	5053	shortcutKey:aKey
dce33f8bb806 intitial checkin ca parents: diff changeset	5054	"set the key to press to select the submenu from the keyboard or if
dce33f8bb806 intitial checkin ca parents: diff changeset	5055	no submenu exists evaluate the action assigned to the item (accept).
dce33f8bb806 intitial checkin ca parents: diff changeset	5056	"
1609 2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	5057	shortcutKey ~~ aKey ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	5058	shortcutKey := aKey.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5059	self invalidate.
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	5060	].
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	5061	!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5062
710 4453e463ff16 add new feature: ca parents: 709 diff changeset	5063	startGroup
4453e463ff16 add new feature: ca parents: 709 diff changeset	5064	"start group #left #right #center ... or nil
4453e463ff16 add new feature: ca parents: 709 diff changeset	5065	at the moment only #right is implemented
4453e463ff16 add new feature: ca parents: 709 diff changeset	5066	"
4453e463ff16 add new feature: ca parents: 709 diff changeset	5067	^ startGroup
4453e463ff16 add new feature: ca parents: 709 diff changeset	5068	!
4453e463ff16 add new feature: ca parents: 709 diff changeset	5069
4453e463ff16 add new feature: ca parents: 709 diff changeset	5070	startGroup:aSymbol
4453e463ff16 add new feature: ca parents: 709 diff changeset	5071	"start group #left #right #center ...
4453e463ff16 add new feature: ca parents: 709 diff changeset	5072	at the moment only #right is implemented
4453e463ff16 add new feature: ca parents: 709 diff changeset	5073	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5074	startGroup := aSymbol.
710 4453e463ff16 add new feature: ca parents: 709 diff changeset	5075	!
4453e463ff16 add new feature: ca parents: 709 diff changeset	5076
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5077	submenu
dce33f8bb806 intitial checkin ca parents: diff changeset	5078	"returns my submenu or nil
dce33f8bb806 intitial checkin ca parents: diff changeset	5079	"
464 a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5080	subMenu notNil ifTrue:[^ subMenu].
a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5081	^ self setupSubmenu
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5082	!
dce33f8bb806 intitial checkin ca parents: diff changeset	5083
dce33f8bb806 intitial checkin ca parents: diff changeset	5084	submenu:aSubMenu
dce33f8bb806 intitial checkin ca parents: diff changeset	5085	"set a new submenu; an existing submenu will be destroyed. This might lead
dce33f8bb806 intitial checkin ca parents: diff changeset	5086	to a redraw if 'hasSubmenu' changed
dce33f8bb806 intitial checkin ca parents: diff changeset	5087	"
1795 6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5088	\|widget\|
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5089
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5090	aSubMenu isNil ifTrue:[
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5091	subMenu notNil ifTrue:[
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5092	subMenu destroy.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5093	subMenu := nil.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5094	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5095	^ self
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5096	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5097
1795 6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5098	(aSubMenu isKindOf:Menu) ifTrue:[
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5099	subMenu := MenuPanel new.
1795 6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5100
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5101	menuPanel notNil ifTrue:[
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5102	subMenu receiver:menuPanel receiver.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5103	].
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5104	subMenu superMenu:menuPanel.
2100 fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5105
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5106	horizontalLayout == true ifTrue:[
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5107	subMenu verticalLayout:false
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5108	].
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5109	subMenu menu:aSubMenu.
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5110	] ifFalse:[
1795 6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5111	aSubMenu isView ifFalse:[
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5112	(aSubMenu isKindOf:ApplicationModel) ifFalse:[
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5113	"/ ... mhhhh ....
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5114	^ self submenuChannel:aSubMenu
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5115	].
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5116	widget := SimpleView new.
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5117	widget client:aSubMenu.
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5118	] ifTrue:[
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5119	widget := aSubMenu
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5120	].
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5121
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5122	(widget isKindOf:MenuPanel) ifTrue:[
2100 fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5123	subMenu := widget.
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5124	horizontalLayout == true ifTrue:[ subMenu verticalLayout:false ].
1795 6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5125	] ifFalse:[
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5126	subMenu := MenuPanel new.
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5127	subMenu receiver:menuPanel receiver.
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5128	subMenu addSubView:widget.
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5129	subMenu extent:(widget preferredExtent).
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5130	widget origin:0.0@0.0 corner:1.0@1.0.
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5131	].
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	5132	subMenu superMenu:menuPanel.
1929 58586354e428 bug fix: keepLinkedMenu ca parents: 1923 diff changeset	5133	].
58586354e428 bug fix: keepLinkedMenu ca parents: 1923 diff changeset	5134	self keepLinkedMenu ifTrue:[
58586354e428 bug fix: keepLinkedMenu ca parents: 1923 diff changeset	5135	submenuChannel := nil
58586354e428 bug fix: keepLinkedMenu ca parents: 1923 diff changeset	5136	]
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5137	!
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5138
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5139	textLabel
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5140	"returns my textLabel or nil if none text
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5141	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5142	\|txt\|
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5143
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5144	rawLabel notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5145	rawLabel isArray ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5146	^ rawLabel perform:#string ifNotUnderstood:nil
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5147	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5148
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5149	rawLabel do:[:el\|
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5150	(txt := el perform:#string ifNotUnderstood:nil) notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5151	^ txt
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5152	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5153	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5154	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5155	^ nil
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5156
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5157	!
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5158
1841 5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5159	triggerOnDown
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5160	"trigger the action if pressed
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5161	"
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5162	triggerOnDown == true ifTrue:[
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5163	self hasSubmenu ifFalse:[^ true].
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5164	triggerOnDown := false.
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5165	].
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5166	^ false
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5167	!
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5168
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5169	triggerOnDown:aBool
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5170	"trigger the action if pressed
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5171	"
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5172	triggerOnDown := aBool.
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5173	!
5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5174
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5175	value
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5176	"gets value
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5177	"
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5178	^ value
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5179	!
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5180
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5181	value:something
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5182	"could be a value holder, an action or selector
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5183	"
d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5184	value := something.
502 dedc1b29b6ac support of arguments ca parents: 498 diff changeset	5185	!
dedc1b29b6ac support of arguments ca parents: 498 diff changeset	5186
dedc1b29b6ac support of arguments ca parents: 498 diff changeset	5187	value:aValue argument:anArgument
dedc1b29b6ac support of arguments ca parents: 498 diff changeset	5188	"set the value and an argument
dedc1b29b6ac support of arguments ca parents: 498 diff changeset	5189	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5190	value := aValue.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5191	argument := anArgument.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5192	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	5193
1679 af40842718f6 when accepting, and the application does not respond to that Claus Gittinger <cg@exept.de> parents: 1670 diff changeset	5194	!MenuPanel::Item methodsFor:'accessing-behavior'!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5195
1074 25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5196	choice
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5197	"implements a radio group; the field
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5198	"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5199	^ choice
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5200
1074 25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5201	!
25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5202
25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5203	choice:something
25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5204	"set choice indication
25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5205	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5206	choice == something ifTrue:[^ self].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5207
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5208	choice isValueModel ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5209	choice removeDependent:self
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5210	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5211
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5212	(choice := something) notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5213	choice isSymbol ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5214	(choice := self aspectAt:choice) isNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5215	choice := something
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5216	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5217	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5218	choice isValueModel ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5219	choice addDependent:self
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5220	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5221	].
1074 25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5222	!
25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5223
25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5224	choiceValue
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5225	"implements a radio group; the value writen to the choice if selected
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5226	"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5227	^ choiceValue
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5228
1074 25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5229	!
25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5230
25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5231	choiceValue:something
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5232	"implements a radio group; the value writen to the choice if selected
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5233	"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5234	choiceValue ~= something ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5235	choiceValue := something.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5236
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5237	choice notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5238	self invalidate
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5239	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5240	].
1074 25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5241	!
25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5242
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5243	delayMenu
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5244	"return true, the menu is shown delayed, if the button is still pressed after a while.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5245	Only useful with buttons in non-popup-menus
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5246	"
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5247	^ delayMenu ? false
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5248	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5249
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5250	delayMenu:aBoolean
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5251	"if true, the menu is shown delayed, if the button is still pressed after a while.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5252	Only useful with buttons in non-popup-menus
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5253	"
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5254	delayMenu := aBoolean.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5255	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5256
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5257	enabled
dce33f8bb806 intitial checkin ca parents: diff changeset	5258	"returns the enabled state
dce33f8bb806 intitial checkin ca parents: diff changeset	5259	"
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5260	\|state\|
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5261
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5262	menuPanel enabled ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5263	enableChannel isSymbol ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5264	state := self aspectAt:enableChannel.
1806 5ca7e602ca7c ignore Backspace in shortKey processing; Claus Gittinger <cg@exept.de> parents: 1800 diff changeset	5265	state isNil ifTrue:[
1902 8676e04e404a * empty log message * Claus Gittinger <cg@exept.de> parents: 1889 diff changeset	5266	('MenuPanel::Item [info]: no aspect for ',enableChannel, ' (in ' , (label?rawLabel) printString , ')') infoPrintCR
1806 5ca7e602ca7c ignore Backspace in shortKey processing; Claus Gittinger <cg@exept.de> parents: 1800 diff changeset	5267	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5268	state isValueModel ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5269	enableChannel := state.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5270	enableChannel addDependent:self.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5271	state := enableChannel value.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5272	] ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5273	state := state value
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5274	]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5275	] ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5276	state := enableChannel value
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5277	].
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5278	^ state ~~ false
460 5334456cedf8 handle enabled symbol; get aspect from application ca parents: 450 diff changeset	5279	].
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5280	^ false
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5281	!
dce33f8bb806 intitial checkin ca parents: diff changeset	5282
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5283	enabled:something
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5284	"change the enabled state; if the state changed, a redraw is performed
dce33f8bb806 intitial checkin ca parents: diff changeset	5285	"
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5286	\|oldState newState\|
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5287
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5288	enableChannel isNil ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5289	oldState := true
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5290	] ifFalse:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5291	oldState := enableChannel value.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5292	enableChannel isValueModel ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5293	enableChannel removeDependent:self
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5294	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5295	].
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5296	enableChannel := something.
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5297
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5298	enableChannel isNil ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5299	menuPanel shown ifFalse:[^ self].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5300	newState := true
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5301	] ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5302	enableChannel isValueModel ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5303	enableChannel addDependent:self
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5304	] ifFalse:[
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5305	enableChannel isSymbol ifTrue:[^ self]
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5306	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5307	menuPanel shown ifFalse:[^ self].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5308	newState := enableChannel value.
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5309	].
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5310
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5311	newState ~~ oldState ifTrue:[
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5312	self invalidate
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5313	].
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5314	!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5315
1670 dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5316	hideMenuOnActivated
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5317	"hide the menu when the item was activated; the default is true
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5318	"
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5319	^ hideMenuOnActivated ? true
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5320
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5321	!
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5322
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5323	hideMenuOnActivated:aBool
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5324	"hide the menu when the item was activated; the default is true
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5325	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5326	hideMenuOnActivated := aBool.
1670 dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5327
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5328
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5329	!
dbc8a05605e0 add new behavior: hideMenuOnActivated ca parents: 1666 diff changeset	5330
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5331	indication
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5332	"get on/off indication
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5333	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5334	^ indication
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5335	!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5336
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5337	indication:something
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5338	"set on/off indication
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5339	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5340	indication == something ifTrue:[^ self].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5341
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5342	indication isValueModel ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5343	indication removeDependent:self
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5344	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5345
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5346	(indication := something) notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5347	indication isValueModel ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5348	indication addDependent:self
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5349	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5350	"/ to force an update of the value
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5351	self indicationValue
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5352	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5353	].
464 a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5354	!
a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5355
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5356	keepLinkedMenu
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5357	"get the keepLinkedMenu flag
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5358	"
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5359	^ keepLinkedMenu ? false
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5360	!
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5361
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5362	keepLinkedMenu:aFlag
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5363	"get the keepLinkedMenu flag
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5364	"
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5365	keepLinkedMenu := aFlag
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5366	!
e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5367
464 a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5368	submenuChannel
a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5369	"get the submenu channel
a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5370	"
a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5371	^ submenuChannel
a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5372	!
a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5373
a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5374	submenuChannel:aSelectorOrNil
a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5375	"returns the submenu channel
a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5376	"
a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5377	submenuChannel := aSelectorOrNil.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5378	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	5379
1679 af40842718f6 when accepting, and the application does not respond to that Claus Gittinger <cg@exept.de> parents: 1670 diff changeset	5380	!MenuPanel::Item methodsFor:'accessing-dimension'!
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5381
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5382	moveBy:aPoint
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5383	"move layout origin
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5384	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5385	layout moveBy:aPoint.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5386	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5387
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5388	preferredExtent
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5389	"compute my preferred extent excluding the shortCutKey and the menu identifier
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5390	"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5391	\|isVertical
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5392	x "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5393	y "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5394	s "{ Class:SmallInteger }"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5395	\|
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5396	self isVisible ifFalse:[^ 0@0 ].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5397
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5398	isButton ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5399	s := menuPanel maxAbsoluteButtonLevel.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5400	x := s + HorizontalButtonInset.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5401	y := s + VerticalButtonInset.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5402	] ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5403	x := HorizontalInset.
1766 e3667c5b8b30 may not assign potential nil to a smallInt-typed variable Claus Gittinger <cg@exept.de> parents: 1765 diff changeset	5404	y := (menuPanel isPopUpView ifTrue:[VerticalPopUpInset] ifFalse:[VerticalInset]) ? 2.
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5405	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5406	x := x * 2.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5407	y := y * 2.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5408
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5409	isVertical := menuPanel verticalLayout.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5410
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5411	rawLabel isNil ifTrue:[
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5412	"SEPARATOR"
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5413
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5414	s := self class separatorSize.
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5415	label = '' ifTrue:[
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5416	s := self class halfSeparatorSize.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5417	].
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5418
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5419	"width of doubleSeparator is 5 !!!!"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5420	isVertical ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5421	x := x max:s.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5422	y := y + 5.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5423	] ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5424	y := y max:s.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5425	x := x + 5.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5426	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5427	] ifFalse:[
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5428	x := x + rawLabelExtent x.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5429	y := y + rawLabelExtent y.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5430
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5431	isButton ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5432	menuPanel showSeparatingLines ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5433	"width of separator is 2 plus right offset 1 := 3"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5434	isVertical ifFalse:[x := x + 3] ifTrue:[y := y + 3].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5435	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5436	(indication notNil or:[choice notNil]) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5437	x := x + 2 + menuPanel iconIndicationOff width.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5438	].
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5439	]
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5440	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	5441	^ x@y
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5442	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	5443
1679 af40842718f6 when accepting, and the application does not respond to that Claus Gittinger <cg@exept.de> parents: 1670 diff changeset	5444	!MenuPanel::Item methodsFor:'accessing-help'!
1613 5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5445
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5446	activeHelpKey
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5447	"get the active helpKey; the key to retrieve the helpText from the application
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5448	"
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5449	^ activeHelpKey
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5450	!
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5451
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5452	activeHelpKey:aHelpKey
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5453	"set the active helpKey; the key to retrieve the helpText from the application
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5454	"
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5455	activeHelpKey ~~ aHelpKey ifTrue:[
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5456	activeHelpKey := aHelpKey.
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5457	activeHelpText := nil.
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5458	].
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5459
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5460	!
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5461
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5462	activeHelpText
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5463	"get the active helpText or nil if not yet resolved
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5464	"
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5465	^ activeHelpText
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5466	!
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5467
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5468	activeHelpText:aText
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5469	"set the active helpText
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5470	"
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5471	activeHelpText := aText.
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5472	! !
5e23d6be5918 optimize accessing helpText ca parents: 1612 diff changeset	5473
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5474	!MenuPanel::Item methodsFor:'accessing-look'!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5475
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5476	horizontalLayout
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5477	"on default submenus has a vertical layout;
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5478	true, the submenu has a horizontal layout.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5479	"
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5480	subMenu ifNotNil:[
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5481	^ subMenu verticalLayout == false
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5482	].
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5483	^ horizontalLayout ? false
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5484	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5485
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5486	horizontalLayout:aBoolean
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5487	"on default submenus has a vertical layout;
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5488	true, the submenu has a horizontal layout.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5489	"
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5490	aBoolean == true ifTrue:[
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5491	horizontalLayout := true
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5492	] ifFalse:[
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5493	horizontalLayout := nil "/ default
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5494	].
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5495	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5496
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5497	isButton
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5498	"returns whether item looks like a Button
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5499	"
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5500	^ isButton
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5501	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5502
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5503	isButton:anBoolean
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5504	"sets whether item looks like a Button
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5505	"
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5506	isButton := anBoolean.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5507
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5508	layout notNil ifTrue:[
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5509	self invalidate.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5510	]
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5511
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5512
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5513
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5514	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5515
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5516	layout
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5517	"returns my layout ( Rectangle )
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5518	"
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5519	^ layout
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5520	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5521
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5522	layout:aLayout
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5523	"set a new layout ( Rectangle )
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5524	"
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5525	layout := aLayout.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5526	self invalidate.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5527
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5528	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5529
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5530	showBusyCursorWhilePerforming
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5531	"get the flag which controls if a busy cursor is to be shown
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5532	while performing the menu action. Defaults to false.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5533	"
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5534	^ showBusyCursorWhilePerforming ? false
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5535
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5536
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5537	!
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5538
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5539	showBusyCursorWhilePerforming:aBoolean
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5540	"set/clear the flag which controls if a busy cursor is to be shown
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5541	while performing the menu action. Defaults to false.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5542	"
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5543	showBusyCursorWhilePerforming := aBoolean.
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5544	! !
0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	5545
1705 201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5546	!MenuPanel::Item methodsFor:'activation / deactivation'!
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5547
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5548	currentSubmenu
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5549	"returns the current submenu or nil
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5550	"
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5551	^ subMenu
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5552
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5553
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5554
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5555	!
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5556
1705 201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5557	hideSubmenu
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5558	"hide submenu
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5559	"
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5560	\|id\|
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5561
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5562	subMenu notNil ifTrue:[
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5563	subMenu realized ifFalse:[
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5564	(id := subMenu id) notNil ifTrue:[
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5565	menuPanel device unmapWindow:id
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5566	]
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5567	] ifTrue:[
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5568	subMenu hide
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5569	].
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5570
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5571	subMenu windowGroup:nil.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5572	menuPanel windowGroup removeView:subMenu.
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5573
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5574	"/ release menu if derived from channel
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5575	submenuChannel notNil ifTrue:[
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5576	subMenu := nil
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5577	]
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5578	].
201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	5579	!
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5580
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5581	openSubmenu
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5582	"opens the submenu; make sure, that the submenu and the menPanel
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5583	is fully visible by shifting it into the visible screen area if
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5584	nescessary.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5585	"
1790 98b89f8f4c17 do not select the first item if it represants a submenu ca parents: 1788 diff changeset	5586	\|p o device isVertical topMenu windGrp prefExtent item
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5587	devBot "{ Class:SmallInteger }"
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5588	devRight "{ Class:SmallInteger }"
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5589	width "{ Class:SmallInteger }"
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5590	height "{ Class:SmallInteger }"
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5591	top "{ Class:SmallInteger }"
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5592	left "{ Class:SmallInteger }"
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5593	\|
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5594
1737 c18896a7cb50 replace shown by realized; when opening a submenue-submenue by shortcut key ca parents: 1735 diff changeset	5595	(subMenu notNil and:[subMenu shown not and:[self isSelected and:[menuPanel realized]]]) ifFalse:[
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5596	^ self
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5597	].
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5598
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5599	topMenu := menuPanel topMenu.
1829 bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	5600	(subMenu device notNil and:[topMenu device ~~ subMenu device]) ifTrue:[
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	5601	subMenu releaseDeviceResources.
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	5602	subMenu setDevice:topMenu device id:nil gcId:nil.
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	5603	subMenu recreate.
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	5604	].
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	5605
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5606	windGrp := topMenu windowGroup.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5607
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5608	subMenu superMenu:menuPanel.
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5609	subMenu becomesActiveMenu.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5610	subMenu cursor:Cursor hand.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5611
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5612	windGrp notNil ifTrue:[
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5613	subMenu windowGroup:windGrp.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5614	windGrp addTopView:subMenu.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5615	].
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5616
2111 f3d67f7c0f92 bug fix when opening a menu by mnemonic ca parents: 2100 diff changeset	5617	"Q&D kludge - test whether the layout is nil;
f3d67f7c0f92 bug fix when opening a menu by mnemonic ca parents: 2100 diff changeset	5618	if true recompute the layouts
f3d67f7c0f92 bug fix when opening a menu by mnemonic ca parents: 2100 diff changeset	5619	"
f3d67f7c0f92 bug fix when opening a menu by mnemonic ca parents: 2100 diff changeset	5620	layout ifNil:[menuPanel rearrangeItems].
f3d67f7c0f92 bug fix when opening a menu by mnemonic ca parents: 2100 diff changeset	5621
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5622	" Q&D kludge - if any visibility attributes are blocks;
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5623	TODO: only invoke mustRearrange if any are blocks
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5624	(since I react correctly on valueHolder changes)
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5625	"
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5626	subMenu rearrangeItemsIfItemVisibilityChanged.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5627	subMenu fixSize.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5628
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5629	"compute origin of subMenu
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5630	"
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5631	isVertical := menuPanel verticalLayout.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5632	device := menuPanel device.
1714 b4c05977e9d5 get heigth and width from preferredExtent when open a submenu ca parents: 1710 diff changeset	5633	prefExtent := subMenu preferredExtent.
b4c05977e9d5 get heigth and width from preferredExtent when open a submenu ca parents: 1710 diff changeset	5634	height := prefExtent y.
b4c05977e9d5 get heigth and width from preferredExtent when open a submenu ca parents: 1710 diff changeset	5635	width := prefExtent x.
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5636	devBot := device usableHeight.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5637	devRight := device usableWidth.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5638
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5639	p := isVertical ifTrue:[layout topRight - 2] ifFalse:[layout bottomLeft].
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5640
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5641	menuPanel isPopUpView ifTrue:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5642	o := menuPanel origin + p
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5643	] ifFalse:[
1791 bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	5644	o := menuPanel translatePoint:p to:nil. "/ translate to root window
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5645	].
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5646	left := o x.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5647	top := o y.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5648
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5649	top + height > devBot ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5650	top := isVertical ifTrue:[devBot - height]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5651	ifFalse:[top - layout height - height + 2]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5652	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5653	top := top max:0.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5654
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5655	"/ (isVertical not and:[subMenu isVerticalLayout]) ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5656	"/ top < menuPanel bottom ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5657	"/ left := left + layout width.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5658	"/ ].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5659	"/ left + width > devRight ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5660	"/ left := o x - width - 2
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5661	"/ ].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5662	"/ ].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	5663
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5664	left + width > devRight ifTrue:[
2012 256be477be6d translatePoint fix. Claus Gittinger <cg@exept.de> parents: 2005 diff changeset	5665	left := isVertical ifTrue:[left - layout width - width + 2]
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5666	ifFalse:[devRight - width]
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5667	].
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5668	left := left max:0.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5669
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5670	subMenu origin:(left@top).
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5671
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5672	subMenu realized ifFalse:[
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5673	subMenu realize.
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5674	] ifTrue:[
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5675	topMenu device mapWindow:(subMenu id).
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5676	].
1790 98b89f8f4c17 do not select the first item if it represants a submenu ca parents: 1788 diff changeset	5677
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5678	menuPanel openMenuOnSelect ifFalse:[
1791 bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	5679	( menuPanel superMenu notNil "/ not the top menu
bd26612c387a optimization: no longer use #translatePoint:from:to: ca parents: 1790 diff changeset	5680	or:[((item := subMenu itemAt:1) notNil and:[item hasSubmenu not])] "/ top menu but no submenu item
1790 98b89f8f4c17 do not select the first item if it represants a submenu ca parents: 1788 diff changeset	5681	) ifTrue:[
98b89f8f4c17 do not select the first item if it represants a submenu ca parents: 1788 diff changeset	5682	subMenu selectionIndex:1
98b89f8f4c17 do not select the first item if it represants a submenu ca parents: 1788 diff changeset	5683	]
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5684	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5685	!
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5686
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5687	toggleSubmenuVisibility
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5688	"toggle the visibility of the submenu
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5689	"
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5690	subMenu notNil ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5691	subMenu shown ifTrue:[^ self hideSubmenu]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5692	] ifFalse:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5693	(subMenu := self setupSubmenu) isNil ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5694	"/ cannot open a submenu
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5695	^ self
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5696	]
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5697	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5698	self openSubmenu.
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5699
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5700
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5701	!
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5702
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5703	visibleSubmenu
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5704	"returns the current visible submenu or nil
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5705	"
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5706	subMenu notNil ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5707	subMenu shown ifTrue:[^ subMenu].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5708	].
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5709	^ nil
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5710
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	5711
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5712
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5713	! !
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	5714
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5715	!MenuPanel::Item methodsFor:'building'!
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5716
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5717	aspectAt:aKey
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5718	"retursns value assigned to key or nil
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5719	"
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5720	\|appl value\|
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5721
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5722	appl := menuPanel receiver.
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5723
1219 6a0d677a6fac removed some #isKindOf: calls. Claus Gittinger <cg@exept.de> parents: 1218 diff changeset	5724	(appl isValueModel) ifTrue:[
1775 7b63410aa8b3 allow selector with argument for #enabled and #visible ca parents: 1767 diff changeset	5725	^ appl value:aKey
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5726	].
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5727
2123 091268558e93 * empty log message * ca parents: 2118 diff changeset	5728	appl isNil ifTrue:[
091268558e93 * empty log message * ca parents: 2118 diff changeset	5729	appl := menuPanel application.
091268558e93 * empty log message * ca parents: 2118 diff changeset	5730	].
091268558e93 * empty log message * ca parents: 2118 diff changeset	5731	appl isNil ifTrue:[ ^ nil].
091268558e93 * empty log message * ca parents: 2118 diff changeset	5732
091268558e93 * empty log message * ca parents: 2118 diff changeset	5733	MessageNotUnderstood handle:[:ex\|
091268558e93 * empty log message * ca parents: 2118 diff changeset	5734	ex selector == aKey ifFalse:[
091268558e93 * empty log message * ca parents: 2118 diff changeset	5735	ex reject
091268558e93 * empty log message * ca parents: 2118 diff changeset	5736	].
091268558e93 * empty log message * ca parents: 2118 diff changeset	5737	('MenuPanel [info]: application does not provide aspect: ' , aKey) infoPrintCR.
091268558e93 * empty log message * ca parents: 2118 diff changeset	5738	] do:[
091268558e93 * empty log message * ca parents: 2118 diff changeset	5739	aKey numArgs == 1 ifTrue:[
091268558e93 * empty log message * ca parents: 2118 diff changeset	5740	value := appl perform:aKey with:(argument ? self).
091268558e93 * empty log message * ca parents: 2118 diff changeset	5741	] ifFalse:[
091268558e93 * empty log message * ca parents: 2118 diff changeset	5742	(appl respondsTo:#aspectFor:) ifTrue:[
091268558e93 * empty log message * ca parents: 2118 diff changeset	5743	value := appl aspectFor:aKey
1775 7b63410aa8b3 allow selector with argument for #enabled and #visible ca parents: 1767 diff changeset	5744	] ifFalse:[
2123 091268558e93 * empty log message * ca parents: 2118 diff changeset	5745	value := appl perform:aKey
1775 7b63410aa8b3 allow selector with argument for #enabled and #visible ca parents: 1767 diff changeset	5746	]
7b63410aa8b3 allow selector with argument for #enabled and #visible ca parents: 1767 diff changeset	5747	]
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5748	].
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5749	^ value
1029 c9e90585fa89 only ignore messageNotUnderstood for my aspects. Claus Gittinger <cg@exept.de> parents: 1026 diff changeset	5750
c9e90585fa89 only ignore messageNotUnderstood for my aspects. Claus Gittinger <cg@exept.de> parents: 1026 diff changeset	5751	"Modified: / 29.7.1998 / 11:59:50 / cg"
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5752	! !
d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	5753
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5754	!MenuPanel::Item methodsFor:'change & update'!
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5755
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5756	update:something with:aParameter from:changedObject
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5757
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5758	\|form rect\|
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5759
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5760	(menuPanel isNil or:[layout isNil]) ifTrue:[^ self]. "/ not yet realized or computed
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5761
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5762	self isSeparator ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5763	"/ NOT A SEPARATOR
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5764
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5765	menuPanel shown ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5766	changedObject == enableChannel ifTrue:[
1864 cbc44ec70112 clear selection if item changed to disabled durring selected ca parents: 1862 diff changeset	5767	(enableChannel value == false and:[self isSelected]) ifTrue:[
cbc44ec70112 clear selection if item changed to disabled durring selected ca parents: 1862 diff changeset	5768	^ menuPanel selection:nil.
cbc44ec70112 clear selection if item changed to disabled durring selected ca parents: 1862 diff changeset	5769	].
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5770	^ self invalidate
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5771	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5772
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5773	(changedObject == indication or:[changedObject == choice]) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5774	isButton ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5775	self invalidate
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5776	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5777	"/ invalidate the interactor only
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5778	"/ take any interactor; interactors has the same extent
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5779	form := menuPanel iconIndicationOff.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5780
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5781	rect := Rectangle left:(layout left + HorizontalInset)
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5782	top:(layout top)
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5783	width:(form width)
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5784	height:(layout height).
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5785
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5786	menuPanel invalidate:rect repairNow:false
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5787	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5788	^ self
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5789	].
1692 200a0b2e23c1 call invalidate instead of redraw ca parents: 1691 diff changeset	5790	].
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	5791	].
712 4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	5792
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	5793	changedObject == isVisible ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5794	menuPanel mustRearrange.
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5795	menuPanel rearrangeItems.
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5796	^ self.
712 4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	5797	].
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	5798
498 b4c341497621 bug fixes: ca parents: 475 diff changeset	5799	super update:something with:aParameter from:changedObject
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5800	!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5801
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5802	updateIndicators
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5803	"update indicators
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5804	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5805	(indication notNil and:[indication isSymbol]) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5806	" indication is a selector otherwise a change notification
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5807	is raised from the model !!!!
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	5808	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5809	self update:nil with:nil from:indication
1074 25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	5810	]
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5811	! !
a0cf1f90da2c enabled and style ca parents: 389 diff changeset	5812
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5813	!MenuPanel::Item methodsFor:'converting'!
dce33f8bb806 intitial checkin ca parents: diff changeset	5814
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5815	asMenuItem
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5816	"convert to a MenuItem
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5817	"
466 f025831cdae8 pick a imaged label; create a ResourceRetriever ca parents: 465 diff changeset	5818	\|item label rcv\|
f025831cdae8 pick a imaged label; create a ResourceRetriever ca parents: 465 diff changeset	5819
f025831cdae8 pick a imaged label; create a ResourceRetriever ca parents: 465 diff changeset	5820	label := self label.
f025831cdae8 pick a imaged label; create a ResourceRetriever ca parents: 465 diff changeset	5821	item := MenuItem labeled:(label printString).
f025831cdae8 pick a imaged label; create a ResourceRetriever ca parents: 465 diff changeset	5822
f025831cdae8 pick a imaged label; create a ResourceRetriever ca parents: 465 diff changeset	5823	label isImage ifTrue:[
1473 1f62652f146e use hasSubmenu insteat of submenu if possible; Claus Gittinger <cg@exept.de> parents: 1472 diff changeset	5824	rcv := ResourceRetriever new.
1f62652f146e use hasSubmenu insteat of submenu if possible; Claus Gittinger <cg@exept.de> parents: 1472 diff changeset	5825	rcv className:#MenuEditor.
1f62652f146e use hasSubmenu insteat of submenu if possible; Claus Gittinger <cg@exept.de> parents: 1472 diff changeset	5826	rcv selector:#iconUnknown.
1f62652f146e use hasSubmenu insteat of submenu if possible; Claus Gittinger <cg@exept.de> parents: 1472 diff changeset	5827	item labelImage:rcv.
464 a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	5828	].
466 f025831cdae8 pick a imaged label; create a ResourceRetriever ca parents: 465 diff changeset	5829
434 9898a2909ef0 add active help for items ca parents: 433 diff changeset	5830	item activeHelpKey:activeHelpKey.
460 5334456cedf8 handle enabled symbol; get aspect from application ca parents: 450 diff changeset	5831
1819 576b0aaf9df1 asMenuItem: do not resolve models ca parents: 1811 diff changeset	5832	enableChannel isSymbol ifTrue:[
576b0aaf9df1 asMenuItem: do not resolve models ca parents: 1811 diff changeset	5833	item enabled:enableChannel
460 5334456cedf8 handle enabled symbol; get aspect from application ca parents: 450 diff changeset	5834	].
1727 a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	5835	item font:font.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5836	item accessCharacterPosition:accessCharacterPosition.
1819 576b0aaf9df1 asMenuItem: do not resolve models ca parents: 1811 diff changeset	5837
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5838	item startGroup:startGroup.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5839	item argument:argument.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5840	item nameKey:nameKey.
1609 2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	5841	item shortcutKeyCharacter:shortcutKey.
1819 576b0aaf9df1 asMenuItem: do not resolve models ca parents: 1811 diff changeset	5842	value isSymbol ifTrue:[item value:value].
576b0aaf9df1 asMenuItem: do not resolve models ca parents: 1811 diff changeset	5843	indication isSymbol ifTrue:[item indication:indication].
576b0aaf9df1 asMenuItem: do not resolve models ca parents: 1811 diff changeset	5844	choice isSymbol ifTrue:[item choice:choice].
576b0aaf9df1 asMenuItem: do not resolve models ca parents: 1811 diff changeset	5845	isVisible isSymbol ifTrue:[item isVisible:isVisible].
576b0aaf9df1 asMenuItem: do not resolve models ca parents: 1811 diff changeset	5846
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5847	item choiceValue:choiceValue.
1819 576b0aaf9df1 asMenuItem: do not resolve models ca parents: 1811 diff changeset	5848	item hideMenuOnActivated:hideMenuOnActivated.
576b0aaf9df1 asMenuItem: do not resolve models ca parents: 1811 diff changeset	5849	item keepLinkedMenu:keepLinkedMenu.
576b0aaf9df1 asMenuItem: do not resolve models ca parents: 1811 diff changeset	5850	item showBusyCursorWhilePerforming:showBusyCursorWhilePerforming.
1841 5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5851	item triggerOnDown:(self triggerOnDown).
1045 25d174d7b019 optimize: ca parents: 1044 diff changeset	5852	item isButton:isButton.
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5853
2100 fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5854	self hasSubmenu ifTrue:[
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5855	horizontalLayout == true ifTrue:[
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5856	item horizontalLayout:true
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5857	].
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5858
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5859	submenuChannel isSymbol ifTrue:[
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5860	item submenuChannel:submenuChannel
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5861	] ifFalse:[
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5862	subMenu notNil ifTrue:[
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5863	item submenu:(subMenu asMenu)
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5864	]
fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5865	].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5866	].
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5867	^ item
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5868	!
dce33f8bb806 intitial checkin ca parents: diff changeset	5869
dce33f8bb806 intitial checkin ca parents: diff changeset	5870	menuItem:aMenuItem
dce33f8bb806 intitial checkin ca parents: diff changeset	5871	"setup attributes from a MenuItem
dce33f8bb806 intitial checkin ca parents: diff changeset	5872	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5873	\|lbl\|
389 d5487b5fb834 st80: perform on value ca parents: 388 diff changeset	5874
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5875	menuPanel disabledRedrawDo:[
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5876	label := rawLabel := nil.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5877	accessCharacterPosition := aMenuItem accessCharacterPosition.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5878	argument := aMenuItem argument.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5879	choiceValue := aMenuItem choiceValue.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5880	showBusyCursorWhilePerforming := aMenuItem showBusyCursorWhilePerforming.
2100 fb4eb6025151 menuBuilder: support of horizontal/vertical layout of submenu ca parents: 2098 diff changeset	5881	horizontalLayout := aMenuItem horizontalLayout.
1841 5d01716cc37c implement: triggerOnDown ca parents: 1836 diff changeset	5882	triggerOnDown := aMenuItem triggerOnDown.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5883	hideMenuOnActivated := aMenuItem hideMenuOnActivated.
1767 e6325bfd4fad allow views in subMenus ca parents: 1766 diff changeset	5884	keepLinkedMenu := aMenuItem keepLinkedMenu.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5885	isButton := aMenuItem isButton ? false.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5886	nameKey := aMenuItem nameKey.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5887	startGroup := aMenuItem startGroup.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5888	shortcutKey := aMenuItem shortcutKeyCharacter.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5889	value := aMenuItem value.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5890	activeHelpKey := aMenuItem activeHelpKey.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5891	activeHelpText := nil.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5892
1727 a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	5893	self font:(aMenuItem font).
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	5894
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5895	self enabled:(aMenuItem enabled).
1572 80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	5896	self indication:(aMenuItem indication).
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5897	self choice:(aMenuItem choice).
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5898	self isVisible:(aMenuItem isVisible).
1572 80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	5899
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	5900	(lbl := aMenuItem labelImage value) isNil ifTrue:[
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	5901	lbl := aMenuItem rawLabel. "/ avoid translating &'s twice
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	5902	].
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5903
1572 80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	5904	self label:lbl.
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	5905	submenuChannel := aMenuItem submenuChannel.
80a8e8a38fb1 ca: bugfix ca parents: 1499 diff changeset	5906	self submenu:(aMenuItem submenu).
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5907	]
1033 9badc22e3d03 oops &'s where eliminated twice - leading to double &'s Claus Gittinger <cg@exept.de> parents: 1032 diff changeset	5908
1090 cf3d9f5648da only draw with enteredLevel, if item is enabled Claus Gittinger <cg@exept.de> parents: 1083 diff changeset	5909	"Modified: / 22.8.1998 / 15:34:16 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	5910	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	5911
dce33f8bb806 intitial checkin ca parents: diff changeset	5912	!MenuPanel::Item methodsFor:'drawing'!
dce33f8bb806 intitial checkin ca parents: diff changeset	5913
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5914	drawButton
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5915	"draw as button
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5916	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	5917	\|drawObject fg etchFg level isEnabled isSelected bg ownBgCol
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5918	x "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5919	\|
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5920	drawObject := rawLabel.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5921
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5922	"COMPUTE COLORS"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	5923	isEnabled := self enabled.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5924	(isSelected := self isSelected) ifTrue:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5925	bg := self activeBackgroundColor.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5926	fg := self activeForegroundColor.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5927	] ifFalse:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5928	self isEntered ifTrue:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5929	bg := self buttonEnteredBackgroundColor
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5930	] ifFalse:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5931	bg := self backgroundColor
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5932	].
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	5933	isEnabled ifTrue:[
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5934	fg := menuPanel foregroundColor
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5935	] ifFalse:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5936	fg := menuPanel disabledForegroundColor.
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	5937	etchFg := menuPanel disabledEtchedForegroundColor.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5938	drawObject := self disabledRawLabel
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5939	]
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5940	].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5941
1708 cfaf55b9043d bug fix in background color of button when derives from label(text) ca parents: 1707 diff changeset	5942	(ownBgCol := self backgroundColorFromLabel) notNil ifTrue:[
cfaf55b9043d bug fix in background color of button when derives from label(text) ca parents: 1707 diff changeset	5943	bg := ownBgCol
cfaf55b9043d bug fix in background color of button when derives from label(text) ca parents: 1707 diff changeset	5944	].
cfaf55b9043d bug fix in background color of button when derives from label(text) ca parents: 1707 diff changeset	5945
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5946	"DRAW BACKGROUND"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5947	bg ~= menuPanel backgroundColor ifTrue:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5948	menuPanel paint:bg.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5949	menuPanel fillRectangle:layout.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5950	].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5951
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5952	x := layout left + menuPanel buttonPassiveLevel + HorizontalButtonInset.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5953
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5954	isSelected ifFalse:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5955	"check whether button should be drawn selected; indicator or radio button"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5956
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5957	indication notNil ifTrue:[
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5958	"button is indicator and set"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5959	isSelected := self indicationValue
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5960	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5961	isSelected := (choice notNil and:[choice value = choiceValue]).
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5962	]
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5963	].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5964
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5965	isSelected ifTrue:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5966	level := menuPanel buttonActiveLevel.
2142 ea2a32738005 pressed button label only shifted by one pixel penk parents: 2141 diff changeset	5967	x := x + 1 "level abs".
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5968	] ifFalse:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5969	level := self isEntered ifTrue:[menuPanel buttonEnteredLevel]
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	5970	ifFalse:[menuPanel buttonPassiveLevel].
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	5971	].
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	5972
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	5973	etchFg notNil ifTrue:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	5974	self drawRawLabel:drawObject atX:x+1 yOffset:1 paint:etchFg.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	5975	].
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	5976	self drawRawLabel:drawObject atX:x yOffset:0 paint:fg.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5977
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5978	level ~~ 0 ifTrue:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5979	menuPanel drawButtonEdgesFor:self level:level
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5980	].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5981	!
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5982
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5983	drawLabel
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5984	"draw a labeled entry; no button, no separator.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5985	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	5986	\|scKey cLb cLa drawObject fg etchFg arrow
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	5987	isSelected isEnabled form
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5988	h "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5989	y "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5990	x "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5991	t "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5992	\|
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	5993	drawObject := rawLabel.
1048 a8755e51706d bug fixes: ca parents: 1046 diff changeset	5994
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	5995	isEnabled := self enabled.
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	5996	isSelected := self isSelected.
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	5997	isSelected ifTrue:[
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	5998	fg := self activeForegroundColor
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	5999	] ifFalse:[
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6000	isEnabled ifTrue:[
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6001	fg := menuPanel foregroundColor
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6002	] ifFalse:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6003	fg := menuPanel disabledForegroundColor.
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6004	etchFg := menuPanel disabledEtchedForegroundColor.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6005	drawObject := self disabledRawLabel
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6006	]
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6007	].
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6008
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6009	h := layout height.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6010	x := layout left + HorizontalInset.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6011	t := layout top.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6012
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6013	((form := self indicatorForm) notNil or:[(form := self choiceForm) notNil]) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6014	y := t + ((h - form height) // 2).
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6015
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6016	form displayOn:menuPanel x:x y:y.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6017	x := x + 2 + form width.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6018	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6019
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6020	etchFg notNil ifTrue:[
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6021	self drawRawLabel:drawObject atX:x+1 yOffset:1 paint:etchFg.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6022	].
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6023	self drawRawLabel:drawObject atX:x yOffset:0 paint:fg.
1046 c03b42debacb bug fixes: ca parents: 1045 diff changeset	6024
608 0d8d910768af use default font derived from style ca parents: 601 diff changeset	6025	"/ DRAW SHORTCUT KEY
0d8d910768af use default font derived from style ca parents: 601 diff changeset	6026
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6027	( shortcutKey notNil
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6028	and:[(x := menuPanel shortKeyInset) ~~ 0
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6029	and:[(scKey:= self shortcutKeyAsString) notNil]]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6030	) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6031	x := layout left + x.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6032	y := t + ((h - (scKey heightOn:menuPanel)) // 2).
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6033	y := y + menuPanel font ascent.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6034	scKey displayOn:menuPanel x:x y:y.
608 0d8d910768af use default font derived from style ca parents: 601 diff changeset	6035	].
963 2660033bc16e hide shortKeys in menu (may be later enabled via a classVar) Claus Gittinger <cg@exept.de> parents: 911 diff changeset	6036
608 0d8d910768af use default font derived from style ca parents: 601 diff changeset	6037	"/ DRAW SUBMENU INDICATION
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6038
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6039	(menuPanel isVerticalLayout and:[self hasSubmenu]) ifTrue:[
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6040	arrow := menuPanel rightArrow.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6041	x := layout right - arrow width - HorizontalInset.
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6042	y := t + (h - arrow height // 2).
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6043
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6044	(menuPanel styleSheet is3D not
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6045	or:[(drawObject := menuPanel rightArrowShadow) isNil]) ifTrue:[
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6046	^ menuPanel displayForm:arrow x:x y:y
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6047	].
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6048	cLa := menuPanel shadowColor.
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6049	cLb := menuPanel lightColor.
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6050
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6051	isSelected ifFalse:[
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6052	fg := cLa.
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6053	cLa := cLb.
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6054	cLb := fg
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6055	].
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6056	menuPanel paint:cLa.
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6057	menuPanel displayForm:arrow x:x y:y.
fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6058	menuPanel paint:cLb.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6059	menuPanel displayForm:drawObject x:x y:y.
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6060	]
746 bd252bbe276f better drawing routine for button behavior tz parents: 739 diff changeset	6061
1124 4a7fec62a572 smaller checkbox. Claus Gittinger <cg@exept.de> parents: 1117 diff changeset	6062	"Modified: / 6.9.1998 / 21:48:53 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6063	!
dce33f8bb806 intitial checkin ca parents: diff changeset	6064
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6065	drawRawLabel:aLabel atX:x yOffset:yOffset paint:fg
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6066	"draw a labeled entry; no button, no separator.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6067	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6068	\|mfont fontAscent
1727 a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6069	y "{ Class:SmallInteger }"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6070	y0 "{ Class:SmallInteger }"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6071	x0 "{ Class:SmallInteger }"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6072	\|
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6073
1727 a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6074	mfont := menuPanel setFont:font.
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6075	fontAscent := menuPanel font ascent.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6076	menuPanel paint:fg.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6077
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6078	y := layout top + (layout height - rawLabelExtent y // 2) + yOffset.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6079
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6080	aLabel isArray ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6081	aLabel isImageOrForm ifFalse:[
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6082	y := y + fontAscent.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6083	].
1727 a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6084	aLabel displayOn:menuPanel x:x y:y.
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6085	] ifTrue:[
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6086	aLabel do:[:el\|
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6087	el notNil ifTrue:[
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6088	el isImageOrForm ifFalse:[
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6089	y0 := y + fontAscent
1727 a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6090	] ifTrue:[
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6091	y0 := y
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6092	].
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6093	x0 := x + (rawLabelExtent x - (el widthOn:menuPanel) // 2).
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6094	el displayOn:menuPanel x:x0 y:y0.
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6095	y := y + 1 + (el heightOn:menuPanel)
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6096	] ifFalse:[
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6097	y := y + 3 "/ see #label:
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6098	]
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6099	].
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6100	].
a6365337be59 support setting font in MenuPanel and Editor ca parents: 1726 diff changeset	6101	menuPanel setFont:mfont
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6102	!
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6103
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6104	drawSeparatingLines
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6105	"draw separating lines
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6106	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6107	\|myIndex lfSep rtSep items prevItem nextItem
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6108	lightColor shadowColor
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6109	l "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6110	t "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6111	r "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6112	b "{ Class:SmallInteger }"
706 d716edbdbe47 show separators bug cleaned tz parents: 689 diff changeset	6113	\|
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6114
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6115	items := menuPanel items.
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6116	myIndex := items identityIndexOf:self.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6117
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6118	prevItem := items at:(myIndex - 1) ifAbsent:nil.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6119	lfSep := prevItem notNil and:[prevItem isButton not].
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6120
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6121	nextItem := items at:(myIndex + 1) ifAbsent:nil.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6122	rtSep := nextItem notNil and:[nextItem isButton not].
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6123
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6124	(lfSep or:[rtSep]) ifFalse:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6125	^ self
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6126	].
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6127
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6128	lightColor := menuPanel lightColor.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6129	shadowColor := menuPanel shadowColor.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6130
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6131	menuPanel paint:lightColor.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6132
608 0d8d910768af use default font derived from style ca parents: 601 diff changeset	6133	l := layout left.
0d8d910768af use default font derived from style ca parents: 601 diff changeset	6134	t := layout top.
0d8d910768af use default font derived from style ca parents: 601 diff changeset	6135	r := layout right.
0d8d910768af use default font derived from style ca parents: 601 diff changeset	6136	b := layout bottom.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6137
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6138	menuPanel verticalLayout ifTrue:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6139	lfSep ifTrue:[menuPanel displayLineFromX:l y:t-1 toX:r y:t-1].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6140	rtSep ifTrue:[menuPanel displayLineFromX:l y:b-1 toX:r y:b-1].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6141
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6142	menuPanel paint:shadowColor.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6143	lfSep ifTrue:[menuPanel displayLineFromX:l y:t-2 toX:r y:t-2].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6144	rtSep ifTrue:[menuPanel displayLineFromX:l y:b-2 toX:r y:b-2].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6145	] ifFalse:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6146	lfSep ifTrue:[menuPanel displayLineFromX:l-1 y:t toX:l-1 y:b].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6147	rtSep ifTrue:[menuPanel displayLineFromX:r-1 y:t toX:r-1 y:b].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6148
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6149	menuPanel paint:shadowColor.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6150	lfSep ifTrue:[menuPanel displayLineFromX:l-2 y:t toX:l-2 y:b].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6151	rtSep ifTrue:[menuPanel displayLineFromX:r-2 y:t toX:r-2 y:b].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6152	]
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6153	!
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6154
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6155	drawSeparator
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6156	"draw as separator
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6157	"
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6158	\|type lightColor shadowColor isDouble
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6159	left top
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6160	x0 "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6161	x1 "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6162	y0 "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6163	y1 "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6164	\|
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6165
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6166	type := self separatorType.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6167	(type isNil or:[type == #blankLine]) ifTrue:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6168	^ self
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6169	].
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6170
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6171	isDouble := type == #doubleLine.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6172
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6173	lightColor := menuPanel lightColor.
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6174	shadowColor := menuPanel shadowColor.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6175	menuPanel paint:shadowColor.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6176
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6177	left := layout left.
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6178	top := layout top.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6179
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6180	menuPanel verticalLayout ifTrue:[
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6181	x0 := left + HorizontalInset.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6182	x1 := layout right - HorizontalInset.
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6183	y0 := top - 1 + (layout height // 2).
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6184	isDouble ifTrue:[y0 := y0 - 2].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6185
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6186	menuPanel displayLineFromX:x0 y:y0 toX:x1 y:y0.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6187	isDouble ifTrue:[menuPanel displayLineFromX:x0 y:y0+4 toX:x1 y:y0+4].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6188
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6189	menuPanel paint:lightColor.
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6190	menuPanel displayLineFromX:x0 y:y0+1 toX:x1 y:y0+1.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6191	isDouble ifTrue:[menuPanel displayLineFromX:x0 y:y0+5 toX:x1 y:y0+5].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6192
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6193	] ifFalse:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6194	y1 := layout bottom.
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6195	x0 := left - 1 + (layout width // 2).
c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6196	y0 := top.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6197	isDouble ifTrue:[x0 := x0 - 2].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6198
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6199	menuPanel displayLineFromX:x0 y:y0 toX:x0 y:y1.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6200	isDouble ifTrue:[menuPanel displayLineFromX:x0+4 y:y0 toX:x0+4 y:y1].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6201
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6202	menuPanel paint:lightColor.
2059 c760cfb7d689 code cleanup; Claus Gittinger <cg@exept.de> parents: 2058 diff changeset	6203	menuPanel displayLineFromX:x0+1 y:y0 toX:x0+1 y:y1.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6204	isDouble ifTrue:[menuPanel displayLineFromX:x0+5 y:y0 toX:x0+5 y:y1].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6205	]
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6206	!
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6207
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6208	invalidate
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6209
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6210	(rawLabel notNil and:[menuPanel notNil]) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6211	menuPanel invalidateItem:self repairNow:false
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6212	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6213
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6214
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6215	!
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6216
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6217	redraw
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6218	"redraw item
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6219	"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6220	\|isSelected ownBgCol paint bgColor
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6221	x "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6222	y "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6223	w "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6224	h "{ Class:SmallInteger }"
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6225	\|
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6226
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6227	self isVisible ifFalse:[^ self].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6228
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6229	rawLabel isNil ifTrue:[^ self drawSeparator].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6230	isButton ifTrue:[^ self drawButton].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6231
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6232	"/ DRAW A LABELED ENTRY; no button, no separator
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6233
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6234	isSelected := self isSelected.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6235	bgColor := menuPanel backgroundColor.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6236	paint := isSelected ifTrue:[self activeBackgroundColor] ifFalse:[bgColor].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6237
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6238	(ownBgCol := self backgroundColorFromLabel) notNil ifTrue:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6239	paint := ownBgCol
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6240	].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6241
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6242	paint ~= bgColor ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6243	menuPanel paint:paint.
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6244	menuPanel fillRectangle:layout.
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6245	].
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6246
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6247	menuPanel showSeparatingLines ifTrue:[
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6248	self drawSeparatingLines
608 0d8d910768af use default font derived from style ca parents: 601 diff changeset	6249	].
0d8d910768af use default font derived from style ca parents: 601 diff changeset	6250
650 29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6251	self drawLabel.
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6252
1045 25d174d7b019 optimize: ca parents: 1044 diff changeset	6253	(ownBgCol notNil and:[isSelected]) ifTrue:[
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6254	ownBgCol brightness > 0.5 ifTrue:[menuPanel paint: menuPanel selectionFrameDarkColor]
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6255	ifFalse:[menuPanel paint: menuPanel selectionFrameBrightColor].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6256
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6257	x := layout left.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6258	y := layout top.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6259	w := layout width.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6260	h := layout height.
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6261
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6262	menuPanel displayRectangleX:(x + 1) y:(y + 1) width:(w - 2) height:(h - 2).
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6263	menuPanel displayRectangleX:(x + 2) y:(y + 2) width:(w - 4) height:(h - 4).
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6264	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6265	menuPanel drawLabelEdgeFor:self selected:isSelected.
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6266
1707 4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6267
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6268
4354f516e937 add some comment to methods; split draw routines for buttons labels .. ca parents: 1705 diff changeset	6269
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6270	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	6271
dce33f8bb806 intitial checkin ca parents: diff changeset	6272	!MenuPanel::Item methodsFor:'initialization'!
dce33f8bb806 intitial checkin ca parents: diff changeset	6273
dce33f8bb806 intitial checkin ca parents: diff changeset	6274	destroy
616 a6157b083830 support of different styles ca parents: 608 diff changeset	6275	"destroy submenus, remove dependencies
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6276	"
616 a6157b083830 support of different styles ca parents: 608 diff changeset	6277	self submenu:nil.
a6157b083830 support of different styles ca parents: 608 diff changeset	6278
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6279	enableChannel isValueModel ifTrue:[enableChannel removeDependent:self].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6280	isVisible isValueModel ifTrue:[isVisible removeDependent:self].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6281	indication isValueModel ifTrue:[indication removeDependent:self].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6282	choice isValueModel ifTrue:[choice removeDependent:self].
616 a6157b083830 support of different styles ca parents: 608 diff changeset	6283
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6284	menuPanel := nil.
616 a6157b083830 support of different styles ca parents: 608 diff changeset	6285	!
a6157b083830 support of different styles ca parents: 608 diff changeset	6286
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6287	in:aPanel
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6288	"create item in a menuPanel
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6289	"
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6290	menuPanel := aPanel.
1045 25d174d7b019 optimize: ca parents: 1044 diff changeset	6291	isButton := false.
1811 df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	6292	!
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	6293
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	6294	reinitStyle
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	6295
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	6296	subMenu notNil ifTrue:[
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	6297	subMenu reinitStyle
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	6298	].
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	6299
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	6300	"Created: / 17.8.2000 / 17:57:07 / cg"
df4f5e5b3396 restart under windows Claus Gittinger <cg@exept.de> parents: 1810 diff changeset	6301	"Modified: / 17.8.2000 / 18:00:08 / cg"
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6302	! !
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6303
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6304	!MenuPanel::Item methodsFor:'label basics'!
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6305
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6306	disabledRawLabel
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6307	"returns the label used if the item is disabled
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6308	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6309	\|block form image\|
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6310
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6311	disabledRawLabel notNil ifTrue:[^ disabledRawLabel].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6312
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6313	disabledRawLabel := rawLabel ? ''.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6314
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6315	disabledRawLabel isString ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6316	^ disabledRawLabel
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6317	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6318
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6319	block := [:el\| \|rslt\|
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6320	(rslt := el) notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6321	el isImageOrForm ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6322	el colorMap notNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6323	rslt := menuPanel lightenedImageOnDevice:el
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6324	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6325	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6326	el class == LabelAndIcon ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6327	((form := el icon) notNil and:[form colorMap notNil]) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6328	form := menuPanel lightenedImageOnDevice:form
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6329	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6330	((image := el image) notNil and:[image colorMap notNil]) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6331	image := menuPanel lightenedImageOnDevice:image
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6332	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6333	rslt := LabelAndIcon form:form image:image string:(el string).
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6334	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6335	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6336	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6337	rslt
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6338	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6339
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6340	rawLabel isArray ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6341	disabledRawLabel := Array new:(rawLabel size).
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6342
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6343	rawLabel keysAndValuesDo:[:anIndex :aLabel\|
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6344	disabledRawLabel at:anIndex put:(block value:aLabel)
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6345	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6346	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6347	disabledRawLabel := block value:rawLabel
794 5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6348	].
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6349	^ disabledRawLabel
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6350	!
5ac9de4f5c82 basic routine to access the images; at the moment ca parents: 781 diff changeset	6351
1829 bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	6352	fetchDeviceResources
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	6353	disabledRawLabel := nil.
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	6354	self fetchImages.
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	6355
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	6356	font notNil ifTrue:[
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	6357	font := font onDevice:(menuPanel device)
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	6358	].
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	6359	!
bd8b95c5bb89 migration fixes Claus Gittinger <cg@exept.de> parents: 1825 diff changeset	6360
616 a6157b083830 support of different styles ca parents: 608 diff changeset	6361	fetchImages
a6157b083830 support of different styles ca parents: 608 diff changeset	6362	"fetch images
a6157b083830 support of different styles ca parents: 608 diff changeset	6363	"
2118 89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6364	\|icon\|
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6365
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6366	(rawLabel isNil or:[rawLabel isString]) ifTrue:[
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6367	^ self
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6368	].
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6369	rawLabel isImageOrForm ifTrue:[
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6370	rawLabel := menuPanel imageOnDevice:rawLabel.
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6371	^ self.
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6372	].
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6373
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6374	rawLabel class == LabelAndIcon ifTrue:[
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6375	(icon := rawLabel image) notNil ifTrue:[
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6376	rawLabel image:(menuPanel imageOnDevice:icon)
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6377	].
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6378	(icon := rawLabel icon) notNil ifTrue:[
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6379	rawLabel icon:(menuPanel imageOnDevice:icon)
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6380	].
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6381	^ self
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6382	].
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6383
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6384	rawLabel isArray ifFalse:[^ self].
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6385
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6386	rawLabel keysAndValuesDo:[:i :el\|
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6387	(el notNil and:[el isString not]) ifTrue:[
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6388	el isImageOrForm ifTrue:[
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6389	rawLabel at:i put:(menuPanel imageOnDevice:el).
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6390	] ifFalse:[
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6391	el class == LabelAndIcon ifTrue:[
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6392	(icon := el image) notNil ifTrue:[
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6393	el image:(menuPanel imageOnDevice:icon)
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6394	].
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6395	(icon := el icon) notNil ifTrue:[
89d02ebc5b65 optimize #labels: and #fetchImages in Item. discard block ca parents: 2113 diff changeset	6396	el icon:(menuPanel imageOnDevice:icon)
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6397	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6398	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6399	]
1709 0bc103eb4143 separtaor - label ca parents: 1708 diff changeset	6400	]
1078 3adf74275ebd support choice for buttons ca parents: 1076 diff changeset	6401	].
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6402	!
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6403
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6404	updateAccessCharacterFor:aLabel
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6405	\|s i rest label pos\|
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6406
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6407	(accessCharacter notNil or:[aLabel isNil]) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6408	^ aLabel
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6409	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6410
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6411	aLabel isString ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6412	aLabel class == LabelAndIcon ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6413	aLabel string:(self updateAccessCharacterFor:(aLabel string))
1709 0bc103eb4143 separtaor - label ca parents: 1708 diff changeset	6414	].
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6415	^ aLabel
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6416	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6417
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6418	s := aLabel size.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6419	i := 1.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6420
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6421	label := aLabel.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6422	pos := accessCharacterPosition.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6423
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6424	[((i := label indexOf:$& startingAt:i) ~~ 0 and:[i < s])] whileTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6425	rest := label copyFrom:(i+1).
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6426
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6427	i == 1 ifTrue:[label := rest]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6428	ifFalse:[label := (label copyFrom:1 to:(i-1)), rest].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6429
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6430	(label at:i) == $& ifTrue:[i := i + 1] ifFalse:[pos := i].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6431	s := s - 1.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6432	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6433
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6434	(pos isNil or:[(accessCharacter := label at:pos ifAbsent:nil) isNil]) ifTrue:[
1762 840521c06b92 bugfix for && in label ca parents: 1750 diff changeset	6435	^ label
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6436	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6437
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6438	label isText ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6439	label := Text string:label
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6440	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6441	label emphasisAt:pos add:#underline.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6442	^ label
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6443
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6444	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	6445
1573 fd124ee2bce5 shortcutKeys; arrange layout if selection changed ca parents: 1572 diff changeset	6446	!MenuPanel::Item methodsFor:'printing & storing'!
fd124ee2bce5 shortcutKeys; arrange layout if selection changed ca parents: 1572 diff changeset	6447
fd124ee2bce5 shortcutKeys; arrange layout if selection changed ca parents: 1572 diff changeset	6448	displayString
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6449	^ self class name, '[', label printString, ']'
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6450
1573 fd124ee2bce5 shortcutKeys; arrange layout if selection changed ca parents: 1572 diff changeset	6451	! !
fd124ee2bce5 shortcutKeys; arrange layout if selection changed ca parents: 1572 diff changeset	6452
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6453	!MenuPanel::Item methodsFor:'private'!
dce33f8bb806 intitial checkin ca parents: diff changeset	6454
650 29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6455	activeBackgroundColor
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6456	"returns the active background color derived from menuPanel
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6457	"
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6458
1045 25d174d7b019 optimize: ca parents: 1044 diff changeset	6459	isButton ifTrue: [^menuPanel buttonActiveBackgroundColor].
650 29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6460	^menuPanel activeBackgroundColor
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6461	!
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6462
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6463	activeForegroundColor
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6464	"returns the active foreground color derived from menuPanel
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6465	"
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6466
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6467	^menuPanel activeForegroundColor
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6468	!
29dcdf6a5994 button and label translation support added tz parents: 638 diff changeset	6469
727 3ba54333342a button style from style sheet tz parents: 723 diff changeset	6470	backgroundColor
3ba54333342a button style from style sheet tz parents: 723 diff changeset	6471	"returns the background color derived from menuPanel
3ba54333342a button style from style sheet tz parents: 723 diff changeset	6472	"
3ba54333342a button style from style sheet tz parents: 723 diff changeset	6473
1045 25d174d7b019 optimize: ca parents: 1044 diff changeset	6474	isButton ifTrue: [^menuPanel buttonPassiveBackgroundColor].
727 3ba54333342a button style from style sheet tz parents: 723 diff changeset	6475	^menuPanel backgroundColor
3ba54333342a button style from style sheet tz parents: 723 diff changeset	6476	!
3ba54333342a button style from style sheet tz parents: 723 diff changeset	6477
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6478	backgroundColorFromLabel
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6479	"returns the background color derived from label or nil
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6480	"
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6481	\|run\|
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6482
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6483	label isText ifFalse:[^ nil ].
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6484	run := label emphasis.
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6485	run size == 0 ifTrue:[^ nil ].
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6486
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6487	run := run first.
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6488
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6489	run size == 0 ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6490	(run value isColor and:[run key == #backgroundColor]) ifTrue:[
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6491	^ run value
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6492	]
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6493	] ifFalse:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6494	run do:[:r\|
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6495	(r value isColor and:[r key == #backgroundColor]) ifTrue:[
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6496	^ r value
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6497	]
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6498	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6499	].
dce33f8bb806 intitial checkin ca parents: diff changeset	6500	^ nil
dce33f8bb806 intitial checkin ca parents: diff changeset	6501	!
dce33f8bb806 intitial checkin ca parents: diff changeset	6502
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6503	buttonEnteredBackgroundColor
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6504	"returns the background color to use when thhe mouse has entered
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6505	derived from menuPanel
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6506	"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6507
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6508	isButton ifTrue: [^ menuPanel buttonEnteredBackgroundColor].
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6509	^ menuPanel backgroundColor
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6510
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6511	"Created: / 20.8.1998 / 13:56:10 / cg"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6512	!
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6513
1074 25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	6514	choiceForm
25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	6515	"returns choice form or nil
25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	6516	"
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6517	\|isOn\|
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6518
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6519	choice isNil ifTrue:[^ nil].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6520
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6521	isOn := choice value = choiceValue.
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6522	self enabled ifFalse:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6523	^ isOn ifTrue:[menuPanel iconRadioGroupDisabledOn]
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6524	ifFalse:[menuPanel iconRadioGroupDisabledOff]
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6525	].
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6526	^ isOn ifTrue:[menuPanel iconRadioGroupOn]
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6527	ifFalse:[menuPanel iconRadioGroupOff]
1074 25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	6528	!
25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	6529
663 b418df6b72d8 retrive submenu: ca parents: 661 diff changeset	6530	findSubMenuIn:aRecv
1051 a448c854fcbb catch messageNotUnderstood for #aspectFor: Claus Gittinger <cg@exept.de> parents: 1048 diff changeset	6531	"ask the receiver for a submenu aspect, sending it
a448c854fcbb catch messageNotUnderstood for #aspectFor: Claus Gittinger <cg@exept.de> parents: 1048 diff changeset	6532	#aspectFor: first; then trying the selector itself.
a448c854fcbb catch messageNotUnderstood for #aspectFor: Claus Gittinger <cg@exept.de> parents: 1048 diff changeset	6533	Ignore the error if that message is not understood
a448c854fcbb catch messageNotUnderstood for #aspectFor: Claus Gittinger <cg@exept.de> parents: 1048 diff changeset	6534	(but not other message-not-understoods)"
a448c854fcbb catch messageNotUnderstood for #aspectFor: Claus Gittinger <cg@exept.de> parents: 1048 diff changeset	6535
2069 7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6536	\|subm sel numArgs\|
1795 6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6537
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6538	aRecv isNil ifTrue:[^ nil].
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6539
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6540	sel := submenuChannel asSymbol.
2069 7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6541	numArgs := sel numArgs.
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6542
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6543	numArgs == 0 ifTrue:[
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6544	MessageNotUnderstood handle:[:ex \|
1795 6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6545	\|selector\|
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6546
2069 7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6547	((selector := ex message selector) == sel
1795 6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6548	or:[selector == #aspectFor:]) ifFalse:[
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6549	ex reject
1705 201f9ce1b2d2 checkin from browser ca parents: 1704 diff changeset	6550	].
1795 6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6551	] do:[
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	6552	subm := aRecv aspectFor:sel.
1795 6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6553	].
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6554	subm notNil ifTrue:[^ subm].
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6555	].
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6556
2043 133a9674bcdf * empty log message * Claus Gittinger <cg@exept.de> parents: 2042 diff changeset	6557	(Array with:(aRecv) with:(aRecv class))
133a9674bcdf * empty log message * Claus Gittinger <cg@exept.de> parents: 2042 diff changeset	6558	do:[:aPossibleReceiver \|
2069 7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6559	MessageNotUnderstood handle:[:ex\|
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6560	ex message selector == sel ifFalse:[ ex reject ]
2043 133a9674bcdf * empty log message * Claus Gittinger <cg@exept.de> parents: 2042 diff changeset	6561	] do:[
2069 7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6562	numArgs == 0 ifTrue:[
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6563	subm := aPossibleReceiver perform:sel
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6564	] ifFalse:[
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6565	numArgs == 1 ifTrue:[
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6566	subm := aPossibleReceiver perform:sel with:(argument ? menuPanel)
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6567	] ifFalse:[
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6568	subm := aPossibleReceiver perform:sel with:argument with:menuPanel
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6569	]
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6570	]
2043 133a9674bcdf * empty log message * Claus Gittinger <cg@exept.de> parents: 2042 diff changeset	6571	].
133a9674bcdf * empty log message * Claus Gittinger <cg@exept.de> parents: 2042 diff changeset	6572	subm notNil ifTrue:[^ subm].
1795 6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6573	].
6afd0e768267 submenuChannel selector: allow upto two arguments, the arg and the menu ca parents: 1793 diff changeset	6574
663 b418df6b72d8 retrive submenu: ca parents: 661 diff changeset	6575	^ subm
2043 133a9674bcdf * empty log message * Claus Gittinger <cg@exept.de> parents: 2042 diff changeset	6576
133a9674bcdf * empty log message * Claus Gittinger <cg@exept.de> parents: 2042 diff changeset	6577	"Modified: / 30.10.2001 / 13:28:25 / cg"
663 b418df6b72d8 retrive submenu: ca parents: 661 diff changeset	6578	!
b418df6b72d8 retrive submenu: ca parents: 661 diff changeset	6579
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6580	indicationValue
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	6581	"returns indication value or nil in case of no indication
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6582	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6583	\|numArgs sel recv\|
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6584
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6585	indication isNil ifTrue:[^ nil]. "no indication specified"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6586
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6587	indication isSymbol ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6588	^ indication value == true "block or model"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6589	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6590
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6591	(numArgs := indication numArgs) == 2 ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6592	recv := menuPanel receiver.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6593
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6594	(recv isValueModel) ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6595	(recv notNil or:[(recv := menuPanel application) notNil]) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6596	sel := indication copyFrom:1 to:(indication indexOf:$:).
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6597	sel := sel asSymbol.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6598
2069 7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6599	MessageNotUnderstood handle:[:ex\|
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6600	ex message selector == sel ifFalse:[
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6601	ex reject
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6602	].
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6603	] do:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6604	sel := recv perform:sel with:argument
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6605	]
1690 38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6606	].
38b23fb1a931 add DefaultEnteredLevel and DefaultSelectionFollowsMouse ca parents: 1688 diff changeset	6607	].
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6608	^ sel value == true
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6609	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6610
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6611	numArgs ~~ 0 ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6612	sel := (indication copyWithoutLast:1) asSymbol
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6613	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6614	sel := indication
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6615	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6616	sel := self aspectAt:sel.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6617
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6618	sel isValueModel ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6619	indication := sel.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6620	indication addDependent:self.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6621	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6622	^ sel value == true
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6623	!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6624
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6625	indicationValue:aValue
1218 6ce43fcb2603 code cleanup Claus Gittinger <cg@exept.de> parents: 1217 diff changeset	6626	"set the indication value
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6627	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6628	\|numArgs recv\|
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6629
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6630	indication isNil ifTrue:[^ self]. "no indication specified"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6631
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6632	indication isSymbol ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6633	indication perform:#value: with:aValue ifNotUnderstood:nil. "block or model"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6634	^ self
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6635	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6636
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6637	(numArgs := indication numArgs) == 0 ifTrue:[ "no arguments to selector; cannot set"
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6638	^ self
1218 6ce43fcb2603 code cleanup Claus Gittinger <cg@exept.de> parents: 1217 diff changeset	6639	].
6ce43fcb2603 code cleanup Claus Gittinger <cg@exept.de> parents: 1217 diff changeset	6640
524 d602402ce5ae receiver might be a ValueModel; VW ca parents: 510 diff changeset	6641	recv := menuPanel receiver.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6642	recv isValueModel ifTrue:[^ self].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6643
1218 6ce43fcb2603 code cleanup Claus Gittinger <cg@exept.de> parents: 1217 diff changeset	6644	recv isNil ifTrue:[
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6645	recv := menuPanel application.
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6646	recv isNil ifTrue:[^ self].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6647	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6648
2069 7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6649	MessageNotUnderstood handle:[:ex\|
7891c7d3af69 use new #perform:withOptionalArgument: Claus Gittinger <cg@exept.de> parents: 2064 diff changeset	6650	(ex message selector ~~ indication) ifTrue:[
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6651	ex reject
1889 43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	6652	].
43516e4588ce give warning messages for unimplemented menu-aspects Claus Gittinger <cg@exept.de> parents: 1878 diff changeset	6653	('MenuPanel [info]: application does not respond to ' , indication) infoPrintCR.
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6654	] do:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6655	numArgs == 1 ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6656	recv perform:indication with:aValue
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6657	] ifFalse:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6658	recv perform:indication with:(argument ? self) with:aValue
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6659	]
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6660	].
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6661	!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6662
1074 25e3910947de added choice type menu items (i.e. radioButton behavior) Claus Gittinger <cg@exept.de> parents: 1068 diff changeset	6663	indicatorForm
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6664	"returns indication form or nil
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6665	"
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6666	\|val\|
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6667
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6668	indication isNil ifTrue:[^ nil].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6669
1798 08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6670	val := self indicationValue.
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6671	self enabled ifFalse:[
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6672	^ val == true
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6673	ifTrue:[menuPanel iconIndicationDisabledOn]
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6674	ifFalse:[menuPanel iconIndicationDisabledOff]
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6675	].
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6676	^ val == true
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6677	ifTrue:[menuPanel iconIndicationOn]
08ae92e6fdf3 extra disabled icons for checkBoxes and radioButtons Claus Gittinger <cg@exept.de> parents: 1797 diff changeset	6678	ifFalse:[menuPanel iconIndicationOff]
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6679	!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6680
1081 fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6681	isEntered
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6682	"returns true if the mouse pointer is over the item
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6683	"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6684	^ menuPanel enteredItem == self
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6685
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6686	"Created: / 20.8.1998 / 13:11:50 / cg"
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6687	!
fd67c198eeea added enter/leave processing for enteredLevel/enteredBG processing. Claus Gittinger <cg@exept.de> parents: 1080 diff changeset	6688
464 a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	6689	separatorType
a788fdce92e2 add submenuChannel ca parents: 461 diff changeset	6690	"returns type of separator line or nil
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6691	"
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	6692	\|c lbl\|
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6693
dce33f8bb806 intitial checkin ca parents: diff changeset	6694	rawLabel isNil ifFalse:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6695	^ nil
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6696	].
dce33f8bb806 intitial checkin ca parents: diff changeset	6697
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	6698	(lbl := label value) isNil ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6699	^ #singleLine
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6700	].
dce33f8bb806 intitial checkin ca parents: diff changeset	6701
390 a0cf1f90da2c enabled and style ca parents: 389 diff changeset	6702	lbl size == 1 ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6703	c := lbl first.
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6704	c == $- ifTrue:[^ #singleLine].
3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6705	c == $= ifTrue:[^ #doubleLine].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6706	].
dce33f8bb806 intitial checkin ca parents: diff changeset	6707	^ #blankLine
1130 fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	6708	!
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	6709
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	6710	setupSubmenu
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	6711	\|appl recv subm\|
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	6712
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	6713	submenuChannel notNil ifTrue:[
1609 2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6714	submenuChannel isSymbol ifFalse:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6715	subm := submenuChannel
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6716	] ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6717	appl := menuPanel application.
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6718
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6719	(subm := self findSubMenuIn:appl) isNil ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6720	(recv := menuPanel receiver) ~~ appl ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6721	subm := self findSubMenuIn:recv
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6722	]
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6723	]
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6724	].
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6725
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6726	(subm := subm value) isArray ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6727	subm := Menu new fromLiteralArrayEncoding:subm.
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6728	"/ cg: linked menus also may contain translations ...
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6729	subm notNil ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6730	appl notNil ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6731	subm findGuiResourcesIn:appl.
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6732	]
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6733	].
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6734	].
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6735	self submenu:subm.
1130 fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	6736	].
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	6737
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	6738	^ subMenu
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	6739
fb79ef4aeec8 style changes Claus Gittinger <cg@exept.de> parents: 1124 diff changeset	6740	"Modified: / 19.5.1998 / 19:36:56 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6741	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	6742
dce33f8bb806 intitial checkin ca parents: diff changeset	6743	!MenuPanel::Item methodsFor:'queries'!
dce33f8bb806 intitial checkin ca parents: diff changeset	6744
1217 c6a4c536aa8c care for items which change visibility via Claus Gittinger <cg@exept.de> parents: 1212 diff changeset	6745	canChangeVisibility
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6746	"return true if I am not always visible; can only be changed by a selector
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6747	otherwise there is a change notification raised if the model changed
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6748	"
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6749	^ isVisible isSymbol
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6750	"/ ^ isVisible notNil and:[isVisible ~~ true]
1217 c6a4c536aa8c care for items which change visibility via Claus Gittinger <cg@exept.de> parents: 1212 diff changeset	6751	!
c6a4c536aa8c care for items which change visibility via Claus Gittinger <cg@exept.de> parents: 1212 diff changeset	6752
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6753	canSelect
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6754	"returns true if item is selectable; no separator, visible and enabled.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6755	in case of a choice (RadioButton) i have to check for the choiceValue
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6756	"
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6757	(rawLabel notNil and:[self isVisible and:[self enabled]]) ifTrue:[
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6758	(choice isNil or:[choice value ~= choiceValue]) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6759	^ true
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6760	].
1078 3adf74275ebd support choice for buttons ca parents: 1076 diff changeset	6761	].
3adf74275ebd support choice for buttons ca parents: 1076 diff changeset	6762	^ false
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6763	!
dce33f8bb806 intitial checkin ca parents: diff changeset	6764
2046 012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	6765	containsPoint:aPoint
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	6766	"returns true if aPoint is contained in my layout
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	6767	"
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	6768	(self isVisible and:[layout notNil]) ifTrue:[
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	6769	^ layout containsPoint:aPoint
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	6770	].
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	6771	^ false
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	6772
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	6773	"Created: / 13.11.2001 / 13:55:31 / cg"
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	6774	!
012798480de6 code cleanup Claus Gittinger <cg@exept.de> parents: 2043 diff changeset	6775
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6776	containsPointX:x y:y
dce33f8bb806 intitial checkin ca parents: diff changeset	6777	"returns true if point is contained in my layout
dce33f8bb806 intitial checkin ca parents: diff changeset	6778	"
712 4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6779	(self isVisible and:[layout notNil]) ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6780	^ layout containsPointX:x y:y
505 562d5661a855 check for valid layout ca parents: 502 diff changeset	6781	].
562d5661a855 check for valid layout ca parents: 502 diff changeset	6782	^ false
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6783	!
dce33f8bb806 intitial checkin ca parents: diff changeset	6784
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6785	hasIndication
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6786	"returns true if on/off indication exists
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6787	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6788	^ indication notNil
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6789	!
40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6790
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6791	hasSubmenu
1473 1f62652f146e use hasSubmenu insteat of submenu if possible; Claus Gittinger <cg@exept.de> parents: 1472 diff changeset	6792	"returns true if the item is configured as an subMenu entry
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6793	"
1472 fd1871a0d888 call hasSubmenu insteat of submenu Claus Gittinger <cg@exept.de> parents: 1464 diff changeset	6794	^ subMenu notNil or:[submenuChannel notNil]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6795	!
dce33f8bb806 intitial checkin ca parents: diff changeset	6796
dce33f8bb806 intitial checkin ca parents: diff changeset	6797	isEnabled
dce33f8bb806 intitial checkin ca parents: diff changeset	6798	"returns enabled state
dce33f8bb806 intitial checkin ca parents: diff changeset	6799	"
dce33f8bb806 intitial checkin ca parents: diff changeset	6800	^ self enabled
dce33f8bb806 intitial checkin ca parents: diff changeset	6801	!
dce33f8bb806 intitial checkin ca parents: diff changeset	6802
1723 f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	6803	isLabeledItem
f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	6804	"returns true if the item is no button and no separator
f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	6805	"
f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	6806	^ rawLabel notNil and:[isButton not]
f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	6807	!
f633725a0ace use itemSpace only for horizontal menus and between labeled items ca parents: 1719 diff changeset	6808
608 0d8d910768af use default font derived from style ca parents: 601 diff changeset	6809	isSeparator
0d8d910768af use default font derived from style ca parents: 601 diff changeset	6810	"returns true if item is a separator
0d8d910768af use default font derived from style ca parents: 601 diff changeset	6811	"
0d8d910768af use default font derived from style ca parents: 601 diff changeset	6812	^ rawLabel isNil
0d8d910768af use default font derived from style ca parents: 601 diff changeset	6813	!
0d8d910768af use default font derived from style ca parents: 601 diff changeset	6814
712 4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6815	isVisible
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6816	"returns the visibility state
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6817	"
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6818	\|state\|
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6819
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6820	isVisible isSymbol ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6821	state := self aspectAt:isVisible.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6822
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6823	state isValueModel ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6824	isVisible := state.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6825	isVisible addDependent:self.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6826	state := isVisible.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6827	]
712 4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6828	] ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6829	state := isVisible
1164 e6e9633abf48 kludge fix: invoke mustRearrange to care for block-visibility attributes Claus Gittinger <cg@exept.de> parents: 1156 diff changeset	6830	].
e6e9633abf48 kludge fix: invoke mustRearrange to care for block-visibility attributes Claus Gittinger <cg@exept.de> parents: 1156 diff changeset	6831	^ state value ~~ false
e6e9633abf48 kludge fix: invoke mustRearrange to care for block-visibility attributes Claus Gittinger <cg@exept.de> parents: 1156 diff changeset	6832
e6e9633abf48 kludge fix: invoke mustRearrange to care for block-visibility attributes Claus Gittinger <cg@exept.de> parents: 1156 diff changeset	6833	"Modified: / 5.10.1998 / 12:08:28 / cg"
712 4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6834	!
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6835
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6836	isVisible:something
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6837	"change the state; if the state changed, a redraw is performed
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6838	"
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6839	\|oldState newState\|
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6840
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6841	isVisible isNil ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6842	oldState := true
712 4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6843	] ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6844	oldState := isVisible value.
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6845	isVisible isValueModel ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6846	isVisible removeDependent:self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6847	]
712 4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6848	].
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6849	isVisible := something.
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6850
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6851	isVisible isNil ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6852	newState := true
712 4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6853	] ifFalse:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6854	isVisible isValueModel ifTrue:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6855	isVisible addDependent:self
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6856	] ifFalse:[
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6857	isVisible isSymbol ifTrue:[^ self]
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6858	].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6859	menuPanel shown ifFalse:[^ self].
d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6860	newState := isVisible value.
712 4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6861	].
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6862
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6863	newState ~~ oldState ifTrue:[
1699 d7b522c4b332 grabing and recomputation of items ca parents: 1698 diff changeset	6864	menuPanel mustRearrange
712 4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6865	]
1164 e6e9633abf48 kludge fix: invoke mustRearrange to care for block-visibility attributes Claus Gittinger <cg@exept.de> parents: 1156 diff changeset	6866
e6e9633abf48 kludge fix: invoke mustRearrange to care for block-visibility attributes Claus Gittinger <cg@exept.de> parents: 1156 diff changeset	6867	"Modified: / 5.10.1998 / 12:12:04 / cg"
712 4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6868	!
4167a3f39bff support of visible/invisible items ca parents: 711 diff changeset	6869
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6870	shortcutKeyAsString
dce33f8bb806 intitial checkin ca parents: diff changeset	6871	"converts shortcutKey to a text object
dce33f8bb806 intitial checkin ca parents: diff changeset	6872	"
1609 2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6873	\|nm prefix\|
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6874
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6875	shortcutKey isNil ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6876	^ nil
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6877	].
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6878
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6879	shortcutKey isCharacter ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6880	nm := shortcutKey asString
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6881	] ifFalse:[
1609 2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6882	"/ this is somewhat complicated: we have the symbolic key at hand,
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6883	"/ but want to show the untranslated (inverse keyBoardMapped) key & modifier
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6884	"/ Ask the devices keyboardMap for the backtranslation.
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6885
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6886	nm := menuPanel device keyboardMap keyAtValue:shortcutKey ifAbsent:shortcutKey.
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6887	"/
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6888	"/ some modifier-key combination ?
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6889	"/
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6890	(nm startsWith:#Cmd) ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6891	prefix := #Cmd.
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6892	] ifFalse:[(nm startsWith:#Alt) ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6893	prefix := #Alt.
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6894	] ifFalse:[(nm startsWith:#Meta) ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6895	prefix := #Meta.
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6896	] ifFalse:[(nm startsWith:#Ctrl) ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6897	prefix := #Ctrl.
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6898	]]]].
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6899	prefix notNil ifTrue:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6900	nm := (self shortcutKeyPrefixFor:prefix), (nm copyFrom:(prefix size + 1))
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6901	] ifFalse:[
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6902	nm := nm asString
2c8d62894ebe optimize searchinf for shortCutKeys ca parents: 1600 diff changeset	6903	]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6904	].
608 0d8d910768af use default font derived from style ca parents: 601 diff changeset	6905	^ nm
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6906
987 541dff179cc2 checkin from browser Claus Gittinger <cg@exept.de> parents: 984 diff changeset	6907	"Modified: / 17.7.1998 / 11:56:40 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6908	!
dce33f8bb806 intitial checkin ca parents: diff changeset	6909
dce33f8bb806 intitial checkin ca parents: diff changeset	6910	shortcutKeyPrefixFor:aModifier
dce33f8bb806 intitial checkin ca parents: diff changeset	6911	"returns prefix assigned to a modifier
dce33f8bb806 intitial checkin ca parents: diff changeset	6912	"
dce33f8bb806 intitial checkin ca parents: diff changeset	6913	\|m\|
dce33f8bb806 intitial checkin ca parents: diff changeset	6914
dce33f8bb806 intitial checkin ca parents: diff changeset	6915	m := menuPanel device modifierKeyTopFor:aModifier.
dce33f8bb806 intitial checkin ca parents: diff changeset	6916	m notNil ifTrue:[
1117 3181b8002e05 background color setting Claus Gittinger <cg@exept.de> parents: 1110 diff changeset	6917	^ m , '-'
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6918	].
987 541dff179cc2 checkin from browser Claus Gittinger <cg@exept.de> parents: 984 diff changeset	6919	^ aModifier , '-'.
541dff179cc2 checkin from browser Claus Gittinger <cg@exept.de> parents: 984 diff changeset	6920
541dff179cc2 checkin from browser Claus Gittinger <cg@exept.de> parents: 984 diff changeset	6921	"Modified: / 17.7.1998 / 11:56:46 / cg"
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6922	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	6923
dce33f8bb806 intitial checkin ca parents: diff changeset	6924	!MenuPanel::Item methodsFor:'selection'!
dce33f8bb806 intitial checkin ca parents: diff changeset	6925
dce33f8bb806 intitial checkin ca parents: diff changeset	6926	isSelected
dce33f8bb806 intitial checkin ca parents: diff changeset	6927	"returns true if item is selected
dce33f8bb806 intitial checkin ca parents: diff changeset	6928	"
1998 5059b7c9cd2c * empty log message * Claus Gittinger <cg@exept.de> parents: 1997 diff changeset	6929
5059b7c9cd2c * empty log message * Claus Gittinger <cg@exept.de> parents: 1997 diff changeset	6930	^ menuPanel notNil and:[menuPanel selection == self]
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6931	!
dce33f8bb806 intitial checkin ca parents: diff changeset	6932
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	6933	selected:isSelected
1473 1f62652f146e use hasSubmenu insteat of submenu if possible; Claus Gittinger <cg@exept.de> parents: 1472 diff changeset	6934	"change selection to a state. Dependant on the state open or hide an existing
1f62652f146e use hasSubmenu insteat of submenu if possible; Claus Gittinger <cg@exept.de> parents: 1472 diff changeset	6935	submenu and perform a redraw
1f62652f146e use hasSubmenu insteat of submenu if possible; Claus Gittinger <cg@exept.de> parents: 1472 diff changeset	6936	"
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6937	menuPanel isNil ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6938	^ self hideSubmenu
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6939	].
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6940
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	6941	isSelected ifFalse:[
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6942	self invalidate.
1473 1f62652f146e use hasSubmenu insteat of submenu if possible; Claus Gittinger <cg@exept.de> parents: 1472 diff changeset	6943	self hideSubmenu.
407 40554a07d5aa fix bugs; implement indication; text with backgroundColor ca parents: 399 diff changeset	6944	] ifTrue:[
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	6945	menuPanel realized ifTrue:[
1726 a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6946	(indication isNil or:[isButton not]) ifTrue:[
a4733a8b51e1 support labeled arrays; printing vertical (font not yet supported) ca parents: 1723 diff changeset	6947	self invalidate
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	6948	].
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	6949
1788 e1f32720fbb4 donot automatically open the submenu of a popup menu ca parents: 1787 diff changeset	6950	(menuPanel isPopUpView not or:[menuPanel openMenuOnSelect]) ifTrue:[
1786 f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	6951	(subMenu := self setupSubmenu) notNil ifTrue:[
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	6952	self openSubmenu
f27f48940f48 change behaviour of cursor/key control and menu actication ca parents: 1785 diff changeset	6953	]
1701 026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	6954	]
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	6955	]
026ece539435 prepare delayed open of submenus ca parents: 1699 diff changeset	6956	].
388 dce33f8bb806 intitial checkin ca parents: diff changeset	6957	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	6958
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	6959	!MenuPanel::ScrollActivity class methodsFor:'default icons'!
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6960
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	6961	icon
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6962	"This resource specification was automatically generated
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6963	by the ImageEditor of ST/X."
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6964
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6965	"Do not manually edit this!! If it is corrupted,
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6966	the ImageEditor may not be able to read the specification."
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6967
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6968	"
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	6969	self icon inspect
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	6970	ImageEditor openOnClass:self andSelector:#icon
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6971	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6972
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6973	<resource: #image>
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6974
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6975	^Icon
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	6976	constantNamed:#'MenuPanel::Scrolling class icon'
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	6977	ifAbsentPut:[(Depth1Image new) width: 11; height: 11; photometric:(#palette); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'?>@@@@@@ @C@@N@@<@C8@O<@@@@@@@@a') ; colorMapFromArray:#[0 0 0 255 255 255]; mask:((Depth1Image new) width: 11; height: 11; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@_<@? A<@C @D@@@@@@@@@@@a') ; yourself); yourself]
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6978	! !
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6979
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	6980	!MenuPanel::ScrollActivity class methodsFor:'instance creation'!
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6981
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6982	new
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6983	^ self basicNew initialize
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6984	! !
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6985
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	6986	!MenuPanel::ScrollActivity methodsFor:'accessing'!
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6987
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6988	activeMenu
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6989	"returns the active menu the scrolling is activated on; nil
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6990	is returned if scrolling is deactivated
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6991	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6992	^ activeMenu
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6993	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6994
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6995	direction
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6996	"returns the scroll-direction
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6997	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6998	^ direction
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	6999	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7000
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7001	iconAt:aDirection on:aMenu
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7002	\|icon device index\|
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7003
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7004	device := aMenu device.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7005
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7006	aDirection == #PREV ifTrue:[
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7007	aMenu verticalLayout ifTrue:[index := 3] "/ 3 - 1 * 90 180
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7008	ifFalse:[index := 2] "/ 2 - 1 * 90 90
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7009	] ifFalse:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7010	aMenu verticalLayout ifTrue:[index := 1] "/ 1 - 1 * 90 0
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7011	ifFalse:[index := 4] "/ 4 - 1 * 90 270
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7012	].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7013
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7014	icon := icons at:index.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7015
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7016	(icon isNil or:[icon device ~~ device]) ifTrue:[
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7017	icon := self class icon.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7018	index > 1 ifTrue:[ icon := icon rotated:(index - 1 * 90) ]
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7019	ifFalse:[ icon := icon copy ].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7020
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7021	icon := icon onDevice:device.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7022	icon clearMaskedPixels.
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7023	icons at:index put:icon
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7024	].
2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7025	^ icon
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7026	! !
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7027
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	7028	!MenuPanel::ScrollActivity methodsFor:'initialization'!
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7029
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7030	initialize
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7031
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7032	semaLock := RecursionLock new.
2018 2130a45b7dfe checkin from browser ca parents: 2016 diff changeset	7033	icons := Array new:4.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7034	! !
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7035
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	7036	!MenuPanel::ScrollActivity methodsFor:'queries'!
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7037
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7038	isActive
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7039	"returns true if scrolling is activated
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7040	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7041	^ activeMenu notNil
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7042	! !
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7043
2137 0aaeeab0811d renamed Scrolling to ScrollActivity. Claus Gittinger <cg@exept.de> parents: 2133 diff changeset	7044	!MenuPanel::ScrollActivity methodsFor:'user operations'!
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7045
2047 62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7046	startIfRequiredAt:aDirection on:aMenu
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7047	"start scrolling; returns true if scrolling is activated
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7048	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7049	\|bounds index\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7050
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7051	semaLock critical:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7052	self stop.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7053
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7054	( aDirection notNil
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7055	and:[aMenu notNil
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7056	and:[(bounds := aMenu scrollerBoundsAt:aDirection) notNil]]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7057	) ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7058	activeMenu := aMenu.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7059	direction := aDirection.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7060
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7061	index := aMenu indexOfItemAtScroller:aDirection.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7062
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7063	index ~~ 0 ifTrue:[
2047 62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7064	scrollTask :=
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7065	[
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7066	\|item step\|
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7067
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7068	[
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7069	step := (aDirection == #PREV) ifTrue:[-1] ifFalse:[1].
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7070	( aMenu shown and:[(item := aMenu itemAt:index) notNil] ) ifTrue:[
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7071	aMenu makeItemVisible:item.
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7072	index := index + step.
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7073	].
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7074
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7075	Delay waitForSeconds:(ButtonController defaultInitialDelay).
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7076
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7077	[ aMenu shown and:[(item := aMenu itemAt:index) notNil] ] whileTrue:[
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7078	aMenu makeItemVisible:item.
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7079	Delay waitForSeconds:(ButtonController defaultRepeatDelay).
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7080	index := index + step.
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7081	].
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7082	item := nil.
2084 8aec1132f129 #valueNowOrOnUnwindDo: -> #ensure: Claus Gittinger <cg@exept.de> parents: 2080 diff changeset	7083	] ensure:[
2047 62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7084	scrollTask := nil.
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7085
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7086	item notNil ifTrue:[
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7087	"/ process was killed
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7088	aMenu invalidate:bounds
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7089	]
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7090	]
62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7091	] forkAt:8.
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7092	]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7093	]
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7094	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7095	^ bounds notNil
2047 62de65e3a61b initial delay; autoRepeat delay Claus Gittinger <cg@exept.de> parents: 2046 diff changeset	7096
2048 ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	7097	"Created: ca"
ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	7098
ba472f3f46c7 code cleanup Claus Gittinger <cg@exept.de> parents: 2047 diff changeset	7099	"Modified: / 13.11.2001 / 20:15:52 / cg"
2016 f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7100	!
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7101
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7102	stop
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7103	"stop scrolling; returns true if the scrolling was activated otherwise false
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7104	"
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7105	\|task resp\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7106
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7107	activeMenu isNil ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7108	^ false
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7109	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7110	semaLock critical:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7111	resp := activeMenu notNil.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7112
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7113	(task := scrollTask) notNil ifTrue:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7114	scrollTask := nil.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7115
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7116	Error handle:[:ex\|
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7117	] do:[
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7118	task terminateWithAllSubprocesses.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7119	task waitUntilTerminated.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7120	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7121	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7122	activeMenu := direction := nil.
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7123	].
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7124	^ resp
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7125	! !
f1ba765d4fa7 add scrolling - first ca parents: 2012 diff changeset	7126
388 dce33f8bb806 intitial checkin ca parents: diff changeset	7127	!MenuPanel class methodsFor:'documentation'!
dce33f8bb806 intitial checkin ca parents: diff changeset	7128
dce33f8bb806 intitial checkin ca parents: diff changeset	7129	version
2142 ea2a32738005 pressed button label only shifted by one pixel penk parents: 2141 diff changeset	7130	^ '$Header: /cvs/stx/stx/libwidg2/MenuPanel.st,v 1.313 2002-08-21 09:39:03 penk Exp $'
388 dce33f8bb806 intitial checkin ca parents: diff changeset	7131	! !
dce33f8bb806 intitial checkin ca parents: diff changeset	7132	MenuPanel initialize!

author	penk
	Wed, 21 Aug 2002 11:39:03 +0200
changeset 2142	ea2a32738005
parent 2141	1a9381cdeb13
child 2143	7b99a7348c97
permissions	-rw-r--r--