MenusJArchibald at aol.com JArchibald at aol.comMon Jun 18 14:09:29 UTC 2001
=> 6/18/01 10:04:13 AM EDT, lo at inf.ufsc.br => << I don't have the change set here at work (MenuBar.2.cs), but I'll take a look at home for it. >> I haven't used this, but I found a copy in my download folder. Good luck, Jerry. ____________________________ Jerry L. Archibald systemObjectivesIncorporated ____________________________ -------------- next part -------------- 'From Squeak2.8 of 13 June 2000 [latest update: #2345] on 8 July 2000 at 6:15:26 pm'! "Change Set: Menu Bar Date: 8 July 2000 Author: James L. Benson Copyright 2000 I represent a simple menu bar for Squeak. I require Squeak 2.7 or above."! RectangleMorph subclass: #MenuBarItemMorph instanceVariableNames: 'menu expanded string isEnabled title isExpanded savedEnables ' classVariableNames: '' poolDictionaries: '' category: 'Menu Bar'! !MenuBarItemMorph commentStamp: '<historical>' prior: 0! I represent an item in a menu bar. I consist of a label that appears in the menu bar, and a pull down menu. I may be disabled, so that I may not be selected.! AlignmentMorph subclass: #MenuBarMorph instanceVariableNames: 'menuBarHeight ' classVariableNames: '' poolDictionaries: '' category: 'Menu Bar'! !MenuBarMorph commentStamp: '<historical>' prior: 0! I represent a menu bar! Object subclass: #MenuBarProperties instanceVariableNames: '' classVariableNames: 'MenuBarColor MenuBarDisabledColor MenuBarEnabledColor MenuBarFont MenuBarFontSize MenuBarHeight MenuBarShowDropShadow ' poolDictionaries: '' category: 'Menu Bar'! !MenuBarProperties commentStamp: '<historical>' prior: 0! I contain information about a menu bars appearance.! MenuMorph subclass: #PulldownMenuMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Menu Bar'! !HandMorph methodsFor: 'zurgle' stamp: 'jlb 6/29/2000 00:20'! newMouseFocus: aMorphOrNil | itsPasteUp toView | ((mouseDownMorph isKindOf: MenuItemMorph) and: [(aMorphOrNil isKindOf: MenuItemMorph) not]) ifTrue: [(mouseDownMorph owner isKindOf: MenuMorph) ifTrue: ["Crock: If a menu is proffered with the mouse up and the user clicks down outside it (as is normal in MVC), then the menu goes away and nothing else happens." mouseDownMorph owner deleteIfPopUp. mouseDownMorph _ nil. ^ nil]]. aMorphOrNil ifNotNil: [((itsPasteUp _ aMorphOrNil pasteUpMorph) notNil and: [itsPasteUp automaticViewing]) ifTrue: [toView _ itsPasteUp submorphThat: [:aMorph | aMorphOrNil hasInOwnerChain: aMorph] ifNone: [nil]. (toView notNil and: [toView isCandidateForAutomaticViewing]) ifTrue: [toView openViewerForArgument]]]. mouseDownMorph _ aMorphOrNil. self updateMouseDownTransform. ! ! !MenuBarItemMorph methodsFor: 'accessing' stamp: 'jlb 6/28/2000 11:14'! isEnabled ^isEnabled! ! !MenuBarItemMorph methodsFor: 'accessing' stamp: 'jlb 6/28/2000 20:14'! isEnabled: aBoolean isEnabled _ aBoolean. title color: (isEnabled ifTrue: [MenuBarProperties menuBarEnabledColor] ifFalse: [MenuBarProperties menuBarDisabledColor]). self changed. isEnabled ifTrue: ["restore the enable state of the menu items" savedEnables ifNotNil: [savedEnables do: [:mli | (mli at: 1) isEnabled: (mli at: 2)]]. savedEnables _ nil] ifFalse: [ "save the enable state of the menu line items " savedEnables _ Set new. menu submorphs do: [:m | (m isKindOf: MenuItemMorph) ifTrue: [savedEnables add: (Array with: m with: m isEnabled). m isEnabled: false]]. ]! ! !MenuBarItemMorph methodsFor: 'accessing' stamp: 'jlb 6/28/2000 19:39'! isExpanded ^ isExpanded! ! !MenuBarItemMorph methodsFor: 'accessing' stamp: 'jlb 6/28/2000 19:36'! isExpanded: aBoolean isExpanded _ aBoolean.! ! !MenuBarItemMorph methodsFor: 'accessing' stamp: 'jlb 6/24/2000 21:59'! menu ^ menu! ! !MenuBarItemMorph methodsFor: 'accessing' stamp: 'jlb 6/28/2000 20:26'! menu: aMenuMorph "convert a MenuMorph to become a proper pull down menu" | titleMorph | menu _ aMenuMorph. menu ifNotNil: ["get rid of the title string of the menu in the new world order " titleMorph _ menu firstSubmorph. (titleMorph isKindOf: AlignmentMorph) ifTrue: [titleMorph delete]. "get rid of any stayup stuff" menu items do: [:item | item selector = #toggleStayUp: ifTrue: [item delete]]. menu stayUp: false. "and try not to line up as a line for the first entry" titleMorph _ menu firstSubmorph. (titleMorph isKindOf: MenuLineMorph) ifTrue: [titleMorph delete]. menu useSquareCorners. "menu borderColor: Color black." menu borderWidth: 1. menu color: Color white]! ! !MenuBarItemMorph methodsFor: 'accessing' stamp: 'jlb 6/26/2000 19:37'! title ^ title.! ! !MenuBarItemMorph methodsFor: 'accessing' stamp: 'jlb 6/28/2000 19:47'! title: aString | maxWidth font | title ifNotNil: ["get rid of the current title" title delete. self changed.]. aString ifNil: [bounds _ bounds origin extent: ( self minimumExtent). title _ nil] ifNotNil: ["setup the font for a menu bar entry" font _ StrikeFont familyName: MenuBarProperties menuBarFont size: MenuBarProperties menuBarFontSize emphasized: 0. title _ StringMorph contents: aString font: font emphasis: 1. self addMorph: title. maxWidth _ font maxWidth. bounds _ bounds origin extent: title width + maxWidth @ MenuBarProperties menuBarHeight. self layoutChanged. self changed.]! ! !MenuBarItemMorph methodsFor: 'initialize' stamp: 'jlb 6/28/2000 19:58'! initialize super initialize. borderWidth _ 2. color _ Color veryLightGray. borderColor _ Color transparent. isExpanded _ false. isEnabled _ true. savedEnables _ nil.! ! !MenuBarItemMorph methodsFor: 'initialize' stamp: 'jlb 6/28/2000 19:48'! minimumExtent ^ 16 @ 16.! ! !MenuBarItemMorph methodsFor: 'initialize' stamp: 'jlb 6/28/2000 20:21'! reset borderColor _ Color transparent. self changed. self refreshWorld. self isExpanded: false. ! ! !MenuBarItemMorph methodsFor: 'event handling' stamp: 'jlb 6/28/2000 19:36'! closeMenu menu deleteIfPopUp. isExpanded _ false. ! ! !MenuBarItemMorph methodsFor: 'event handling' stamp: 'jlb 6/25/2000 00:16'! deletedMenu " Somebody deleted my menu ; reset me " self reset. ( self containsPoint: ( self cursorPoint ) ) ifTrue: [ " the user pressed mouse down inside of the menu header " borderColor _ #inset. self changed. ].! ! !MenuBarItemMorph methodsFor: 'event handling' stamp: 'jlb 6/11/2000 16:41'! handlesMouseDown: evt ^ true.! ! !MenuBarItemMorph methodsFor: 'event handling' stamp: 'jlb 6/11/2000 16:31'! handlesMouseOver: evt ^ true ! ! !MenuBarItemMorph methodsFor: 'event handling' stamp: 'jlb 6/25/2000 00:07'! handlesMouseOverDragging: evt ^ true ! ! !MenuBarItemMorph methodsFor: 'event handling' stamp: 'jlb 6/29/2000 15:15'! mouseDown: evt isEnabled ifTrue: [borderColor _ #inset. self changed. "make sure we show the border change immediately" self refreshWorld]. menu notNil ifTrue: [self openMenu: evt hand]! ! !MenuBarItemMorph methodsFor: 'event handling' stamp: 'jlb 6/28/2000 20:20'! mouseEnter: evt | openMenu | (owner isKindOf: MenuBarMorph) ifTrue: [isExpanded ifFalse: ["we may have another open menu in the menu bar ; if so close that one and open ours" openMenu _ false. owner submorphs do: [:m | (m isKindOf: self class) ifTrue: [m isExpanded ifTrue: [m closeMenu. m mouseLeave: evt. openMenu _ true]]]. openMenu ifTrue: [self openMenu: evt hand]]]. isExpanded ifTrue: [borderColor _ #inset] ifFalse: [borderColor _ #raised]. self changed. self refreshWorld! ! !MenuBarItemMorph methodsFor: 'event handling' stamp: 'jlb 6/28/2000 11:15'! mouseEnterDragging: evt " Mouse entered us already down " isEnabled ifTrue: [self borderColor: #inset]. ^ self mouseEnter: evt! ! !MenuBarItemMorph methodsFor: 'event handling' stamp: 'jlb 6/28/2000 20:19'! mouseLeave: evt isExpanded ifFalse: [borderColor _ Color transparent. self changed. self refreshWorld.]! ! !MenuBarItemMorph methodsFor: 'event handling' stamp: 'jlb 6/28/2000 20:28'! openMenu: hand "open my menu under control of the given hand." | ds | MenuBarProperties menuBarShowDropShadow ifTrue: [ds _ DropShadowMorph new. ds color: (ds color alpha: 0.5). ds addMorph: menu] ifFalse: [ " make sure that the silly drop shadow is gone " (menu owner isKindOf: DropShadowMorph) ifTrue: [menu delete]]. menu user: self. " Make sure that nothing is currently selected in the menu " menu submorphs do: [:m | (m isKindOf: MenuItemMorph) ifTrue: [ m isSelected: false]]. menu pullDownAtPoint: bounds bottomLeft forHand: hand. isExpanded _ true. ! ! !MenuBarItemMorph methodsFor: 'geometry' stamp: 'jlb 6/24/2000 23:58'! layoutChanged | sm | super layoutChanged. ( sm _ self findA: StringMorph ) ifNotNil: [ sm position: self center - (sm extent // 2). ]. ! ! !MenuBarItemMorph class methodsFor: 'instance creation' stamp: 'jlb 6/29/2000 14:56'! fromMenuMorph: aMenuMorph | newMorph | newMorph _ aMenuMorph as: PulldownMenuMorph. aMenuMorph become: newMorph. ^ self fromString: ( aMenuMorph getTitleString ) menu: aMenuMorph.! ! !MenuBarItemMorph class methodsFor: 'instance creation' stamp: 'jlb 6/26/2000 19:23'! fromString: aString | toReturn | toReturn _ self new. toReturn title: aString. ^ toReturn! ! !MenuBarItemMorph class methodsFor: 'instance creation' stamp: 'jlb 6/26/2000 19:23'! fromString: aString menu: aMenuMorph | toReturn | toReturn _ self new. toReturn title: aString. toReturn menu: aMenuMorph. ^ toReturn! ! !MenuBarMorph methodsFor: 'geometry' stamp: 'jlb 6/7/2000 19:36'! ownerChanged super ownerChanged. self extent: ( (owner bounds width ) @ menuBarHeight ). ! ! !MenuBarMorph methodsFor: 'adding / removing' stamp: 'jlb 6/28/2000 22:26'! append: aMenuBarItemMorph self addMorphBack: aMenuBarItemMorph! ! !MenuBarMorph methodsFor: 'adding / removing' stamp: 'jlb 6/26/2000 09:53'! clear " delete all of the menu bar items " self removeAllMorphs.! ! !MenuBarMorph methodsFor: 'adding / removing' stamp: 'jlb 6/26/2000 09:53'! delete: aMenuBarItemMorph aMenuBarItemMorph delete.! ! !MenuBarMorph methodsFor: 'adding / removing' stamp: 'jlb 6/26/2000 19:07'! insert: aMenuBarItemMorph before: anItemMorph " Insert a menu before anItem in the menu bar " self addMorph: aMenuBarItemMorph inFrontOf: anItemMorph.! ! !MenuBarMorph methodsFor: 'drawing' stamp: 'jlb 6/28/2000 22:29'! drawOn: aCanvas super drawOn: aCanvas. "draw a seperator line at the bottom of the morph" aCanvas line: bounds bottomLeft - (0 @ 1) to: bounds bottomRight - (0 @ 1) width: 1 color: Color black! ! !MenuBarMorph methodsFor: 'menus' stamp: 'jlb 6/29/2000 00:38'! collapse " Don't collapse menu bars "! ! !MenuBarMorph methodsFor: 'initialize' stamp: 'jlb 6/28/2000 20:31'! initialize super initialize. self color: MenuBarProperties menuBarColor. menuBarHeight _ MenuBarProperties menuBarHeight. self setToAdhereToEdge: #topLeft. borderWidth _ 0. self beSticky. ! ! !MenuBarMorph methodsFor: 'initialize' stamp: 'jlb 6/28/2000 19:38'! reset submorphs do: [ :m | m isExpanded: false. m reset. ]! ! !MenuBarMorph class methodsFor: 'example' stamp: 'jlb 7/7/2000 20:02'! example | mb hand aMenu mi | "MenuBarMorph example " mb _ self new. " get a little away from the edge; you should put Squeak icon here " " mb addTransparentSpacerOfSize: ( 16 @ 0 ). " hand _ self currentWorld activeHand. " world menu " aMenu _ hand buildWorldMenu. mi _ MenuBarItemMorph fromMenuMorph: aMenu. mi title: 'World'. mb append: mi. false ifTrue: [ " This doesn't work in 2.7 " " Project menu " aMenu _ hand projectMenu. mi _ MenuBarItemMorph fromMenuMorph: aMenu. mi title: 'Project'. mb append: mi. ]. " Changes menu " aMenu _ hand changesMenu. mi _ MenuBarItemMorph fromMenuMorph: aMenu. mi title: 'Changes'. mb append: mi. " Appearance menu " aMenu _ hand appearanceMenu. mi _ MenuBarItemMorph fromMenuMorph: aMenu. mi title: 'Appearance'. mb append: mi. " Debug menu " aMenu _ hand debugMenu. mi _ MenuBarItemMorph fromMenuMorph: aMenu. mi title: 'Debug'. mb append: mi. " Disable for fanciness " mi isEnabled: false. " Windows menu " aMenu _ hand windowsMenu. mi _ MenuBarItemMorph fromMenuMorph: aMenu. mi title: 'Windows'. mb append: mi. " Help menu " aMenu _ hand helpMenu. mi _ MenuBarItemMorph fromMenuMorph: aMenu. mi title: 'Help'. mb append: mi. mb openInWorld.! ! !MenuBarProperties methodsFor: 'look in class' stamp: 'jlb 6/26/2000 19:45'! seeClassSide "All the code for MenuBarProperties is on the class side"! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 19:59'! menuBarColor " the color of the menu bar " ^ MenuBarColor! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 19:59'! menuBarColor: aColor " Set the color of the menu bar property " MenuBarColor _ aColor! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 20:03'! menuBarDisabledColor " The color of a disabled item in the menu bar " ^ MenuBarDisabledColor! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 20:03'! menuBarDisabledColor: aColor " set the color of a disabled item in the menu bar " MenuBarDisabledColor _ aColor.! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 20:03'! menuBarEnabledColor " the color of a enabled item in the menu bar " ^ MenuBarEnabledColor! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 20:04'! menuBarEnabledColor: aColor " set the color of a enabled item in the menu bar " MenuBarEnabledColor _ aColor.! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 20:23'! menuBarFont " return the name of the menuBar font family " ^ MenuBarFont.! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 20:23'! menuBarFont: aFontFamilyName " set the name of the menuBar font family " MenuBarFont _ aFontFamilyName.! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 19:59'! menuBarFontSize " the size of the font for strings in the menu bar " ^ MenuBarFontSize! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 19:59'! menuBarFontSize: anInteger " set the size of the font for strings in the menu bar " MenuBarFontSize _ anInteger! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 20:00'! menuBarHeight " the height of the menu bar in pixels " ^ MenuBarHeight.! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 20:00'! menuBarHeight: anInteger " set the height of the menu bar in pixels " MenuBarHeight _ anInteger! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 20:31'! menuBarShowDropShadow " show the drop shadow when menus are pulled down " ^ MenuBarShowDropShadow! ! !MenuBarProperties class methodsFor: 'properties' stamp: 'jlb 6/26/2000 20:32'! menuBarShowDropShadow: aBoolean " show the drop shadow when menus are pulled down " MenuBarShowDropShadow _ aBoolean! ! !MenuBarProperties class methodsFor: 'class initialization' stamp: 'jlb 6/26/2000 20:33'! initialize " MenuBarProperties initialize " self menuBarHeight: 24. self menuBarColor: Color veryLightGray. self menuBarEnabledColor: Color black. self menuBarDisabledColor: Color gray. self menuBarFont: #NewYork. self menuBarFontSize: 20. self menuBarShowDropShadow: true.! ! !MenuMorph methodsFor: 'zurgle' stamp: 'jlb 6/24/2000 22:57'! deleteIfPopUp "Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu." stayUp ifFalse: [self topRendererOrSelf delete. self user ifNotNil: [ self user deletedMenu ]]. (popUpOwner notNil and: [popUpOwner isKindOf: MenuItemMorph]) ifTrue: [ popUpOwner isSelected: false. (popUpOwner owner isKindOf: MenuMorph) ifTrue: [popUpOwner owner deleteIfPopUp]]. ! ! !MenuMorph methodsFor: 'zurgle' stamp: 'jlb 6/26/2000 22:30'! getTitleString | aMorph nameMorph | aMorph _ self submorphs first. (aMorph isKindOf: AlignmentMorph) ifTrue: [ nameMorph _ aMorph submorphs first. (nameMorph isKindOf: StringMorph) ifTrue: [ ^ nameMorph contents ]]. ^ 'Untitled'. ! ! !MenuMorph methodsFor: 'zurgle' stamp: 'jlb 6/28/2000 00:01'! pullDownAtPoint: aPoint forHand: hand "Present this menu at the given point under control of the given hand; do not adjust point to fit menu in world" | selectedItem i yOffset sub | popUpOwner _ hand. originalEvent _ hand lastEvent. selectedItem _ self items detect: [:each | each == lastSelection] ifNone: [self items isEmpty ifTrue: [^ self] ifFalse: [self items first]]. "Note: items may not be laid out yet (I found them all to be at 0 at 0), so have to add up heights of items above the selected item." i _ 0. yOffset _ 0. [(sub _ self submorphs at: (i _ i + 1)) == selectedItem] whileFalse: [yOffset _ yOffset + sub height]. self position: aPoint . hand world addMorphFront: (( owner isKindOf: DropShadowMorph ) ifTrue: [ owner ] ifFalse: [ self ] ). hand world startSteppingSubmorphsOf: self. hand newMouseFocus: selectedItem. self changed! ! !MenuMorph methodsFor: 'zurgle' stamp: 'jlb 6/24/2000 22:52'! user | user | "This returns the an interested party to the menu" (user _ self valueOfProperty: #user) ifNotNil: [^ user]. ^ nil! ! !MenuMorph methodsFor: 'zurgle' stamp: 'jlb 6/24/2000 22:51'! user: aMorph "This sets the interested party to the menu to be a Morph" self setProperty: #user toValue: aMorph. ! ! !PulldownMenuMorph methodsFor: 'accessing' stamp: 'jlb 6/29/2000 14:59'! getTitleString | aMorph nameMorph | aMorph _ self submorphs first. (aMorph isKindOf: AlignmentMorph) ifTrue: [ nameMorph _ aMorph submorphs first. (nameMorph isKindOf: StringMorph) ifTrue: [ ^ nameMorph contents ]]. ^ 'Untitled'. ! ! !PulldownMenuMorph methodsFor: 'accessing' stamp: 'jlb 6/29/2000 14:59'! user | user | "This returns the an interested party to the menu" (user _ self valueOfProperty: #user) ifNotNil: [^ user]. ^ nil! ! !PulldownMenuMorph methodsFor: 'accessing' stamp: 'jlb 6/29/2000 14:59'! user: aMorph "This sets the interested party to the menu to be a Morph" self setProperty: #user toValue: aMorph. ! ! !PulldownMenuMorph methodsFor: 'control' stamp: 'jlb 6/29/2000 14:59'! pullDownAtPoint: aPoint forHand: hand "Present this menu at the given point under control of the given hand; do not adjust point to fit menu in world" | selectedItem i yOffset sub | popUpOwner _ hand. originalEvent _ hand lastEvent. selectedItem _ self items detect: [:each | each == lastSelection] ifNone: [self items isEmpty ifTrue: [^ self] ifFalse: [self items first]]. "Note: items may not be laid out yet (I found them all to be at 0 at 0), so have to add up heights of items above the selected item." i _ 0. yOffset _ 0. [(sub _ self submorphs at: (i _ i + 1)) == selectedItem] whileFalse: [yOffset _ yOffset + sub height]. self position: aPoint . hand world addMorphFront: (( owner isKindOf: DropShadowMorph ) ifTrue: [ owner ] ifFalse: [ self ] ). hand world startSteppingSubmorphsOf: self. hand newMouseFocus: selectedItem. self changed! ! !PulldownMenuMorph methodsFor: 'submorphs-add/remove' stamp: 'jlb 6/29/2000 15:10'! delete " take me off of the display and tell my user I'm through " (owner isKindOf: DropShadowMorph) ifTrue: [ owner delete] ifFalse: [super delete]. self user ifNotNil: [ self user reset].! ! MenuBarProperties initialize! !MenuBarProperties class reorganize! ('properties' menuBarColor menuBarColor: menuBarDisabledColor menuBarDisabledColor: menuBarEnabledColor menuBarEnabledColor: menuBarFont menuBarFont: menuBarFontSize menuBarFontSize: menuBarHeight menuBarHeight: menuBarShowDropShadow menuBarShowDropShadow:) ('class initialization' initialize) ! !MenuBarProperties reorganize! ('look in class' seeClassSide) ! !MenuBarMorph class reorganize! ('example' example) ! "Postscript: Initialize class" MenuBarProperties initialize.!
More information about the Squeak-dev mailing list |