'From Cuis 1.0 of 19 April 2009 [latest update: #187] on 19 May 2009 at 11:19:50 am'!
!classDefinition: #BorderedMorph category: #'Morphic-OldKernel'!
Morph subclass: #BorderedMorph
	instanceVariableNames: 'borderWidth borderColor borderStyle '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-OldKernel'!
!classDefinition: #BrowserCommentTextMorph category: #'Tools-Browser'!
PluggableTextMorph subclass: #BrowserCommentTextMorph
	instanceVariableNames: 'browserWindow browserLowerPane '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-Browser'!
!classDefinition: #SystemWindow category: #'Morphic-OldWindows'!
MorphWithModel subclass: #SystemWindow
	instanceVariableNames: 'labelString paneMorphs collapsedFrame fullFrame isCollapsed updatablePanes paneColor '
	classVariableNames: 'CloseBoxImage CollapseBoxImage TopWindow '
	poolDictionaries: ''
	category: 'Morphic-OldWindows'!

!Object methodsFor: 'viewer' stamp: 'jmv 5/17/2009 23:07'!
externalName
	"Answer an external name by which the receiver is known.  Generic implementation here is a transitional backstop. probably"

	^ [(self asString copyWithout: Character cr) truncateTo:  27] ifError:
		[:msg :rcvr | ^ self class name printString]! !


!CustomMenu methodsFor: 'construction' stamp: 'jmv 5/17/2009 23:41'!
addStayUpIcons
	"For compatibility with MenuMorph.  Here it is a no-op"! !


!LightWidget methodsFor: 'debug and other' stamp: 'jmv 5/17/2009 23:41'!
buildDebugMenu: aHand 
	"Answer a debugging menu for the receiver.  The hand argument is seemingly historical and plays no role presently"

	| aMenu |
	aMenu := MenuMorph new defaultTarget: self.
	aMenu addStayUpIcons.
	self isKnownFailing
		ifTrue: 
			[aMenu add: 'start drawing again' translated action: #resumeAfterDrawError.
			aMenu addLine].
	(self hasProperty: #errorOnStep) 
		ifTrue: 
			[aMenu add: 'start stepping again' translated action: #resumeAfterStepError.
			aMenu addLine].
	aMenu add: 'inspect morph' translated action: #inspectInMorphic:.
	aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain.
	self isMorphicModel 
		ifTrue: 
			[aMenu 
				add: 'inspect model' translated
				target: self model
				action: #inspect].
	aMenu 
		add: 'explore morph' translated
		target: self
		selector: #explore.
	aMenu addLine.
	aMenu 
		add: 'browse morph class' translated
		target: self
		selector: #browseHierarchy.
	self isMorphicModel 
		ifTrue: 
			[aMenu 
				add: 'browse model class'
				target: self model
				selector: #browseHierarchy].
	aMenu addLine.
	aMenu
		add: 'control-menu...' translated
			target: self
			selector: #invokeMetaMenu:;
		add: 'edit balloon help' translated action: #editBalloonHelpText.
	^aMenu! !


!Morph methodsFor: 'accessing' stamp: 'jmv 5/17/2009 23:14'!
borderWidth
	^0! !

!Morph methodsFor: 'caching' stamp: 'jmv 5/17/2009 23:04'!
releaseCachedState
	"Release any state that can be recomputed on demand, such as the pixel values for a color gradient or the editor state for a TextMorph. This method may be called to save space when a morph becomes inaccessible. Implementations of this method should do 'super releaseCachedState'."! !

!Morph methodsFor: 'debug and other' stamp: 'jmv 5/17/2009 23:42'!
buildDebugMenu: aHand 
	"Answer a debugging menu for the receiver.  The hand argument is seemingly historical and plays no role presently"

	| aMenu |
	aMenu := MenuMorph new defaultTarget: self.
	aMenu addStayUpIcons.
	self isKnownFailing
		ifTrue: 
			[aMenu add: 'start drawing again' translated action: #resumeAfterDrawError.
			aMenu addLine].
	(self hasProperty: #errorOnStep) 
		ifTrue: 
			[aMenu add: 'start stepping again' translated action: #resumeAfterStepError.
			aMenu addLine].
	aMenu add: 'inspect morph' translated action: #inspectInMorphic:.
	aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain.
	self isMorphicModel 
		ifTrue: 
			[aMenu 
				add: 'inspect model' translated
				target: self model
				action: #inspect].
	aMenu 
		add: 'explore morph' translated
		target: self
		selector: #explore.
	aMenu addLine.
	aMenu 
		add: 'browse morph class' translated
		target: self
		selector: #browseHierarchy.
	self isMorphicModel 
		ifTrue: 
			[aMenu 
				add: 'browse model class'
				target: self model
				selector: #browseHierarchy].
	aMenu addLine.
	aMenu
		add: 'control-menu...' translated
			target: self
			selector: #invokeMetaMenu:;
		add: 'edit balloon help' translated action: #editBalloonHelpText.
	^aMenu! !

!Morph methodsFor: 'drawing' stamp: 'jmv 5/17/2009 23:03'!
drawOn: aCanvas

	aCanvas fillRectangle: self bounds fillStyle: self fillStyle! !

!Morph methodsFor: 'geometry' stamp: 'jmv 5/17/2009 23:13'!
innerBounds
	"Return the inner rectangle enclosed by the bounds of this morph excluding the space taken by its borders. For an unbordered morph, this is just its bounds."

	^ self bounds! !

!Morph methodsFor: 'menus' stamp: 'jmv 5/17/2009 23:41'!
addHaloActionsTo: aMenu 
	"Add items to aMenu representing actions requestable via halo"

	| subMenu |
	subMenu := MenuMorph new defaultTarget: self.
	subMenu addTitle: self externalName.
	subMenu addStayUpIcons.
	subMenu addLine.
	subMenu add: 'delete' translated action: #dismissViaHalo.
	subMenu 
		balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' 
				translated.
	self maybeAddCollapseItemTo: subMenu.
	subMenu add: 'grab' translated action: #openInHand.
	subMenu 
		balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' 
				translated.
	subMenu addLine.
	subMenu add: 'resize' translated action: #resizeFromMenu.
	subMenu 
		balloonTextForLastItem: 'Change the size of this object' translated.
	subMenu add: 'duplicate' translated action: #maybeDuplicateMorph.
	subMenu balloonTextForLastItem: 'Hand me a copy of this object' translated.
	subMenu 
		add: 'set color' translated
		target: self
		action: #changeColor.
	subMenu 
		balloonTextForLastItem: 'Change the color of this object' translated.
	subMenu 
		add: 'inspect' translated
		target: self
		action: #inspect.
	subMenu 
		balloonTextForLastItem: 'Open an Inspector on this object' translated.
	aMenu add: 'halo actions...' translated subMenu: subMenu! !

!Morph methodsFor: 'meta-actions' stamp: 'jmv 5/17/2009 23:42'!
buildHandleMenu: aHand
	"Build the morph menu for the given morph's halo's menu handle. This menu has two sections. The first section contains commands that are interpreted by the hand; the second contains commands provided by the target morph. This method allows the morph to decide which items should be included in the hand's section of the menu."

	| menu |
	menu _ MenuMorph new defaultTarget: self.
	menu addStayUpIcons.
	menu addLine.
	self addStandardHaloMenuItemsTo: menu hand: aHand.
	menu defaultTarget: aHand.
	self addAddHandMenuItemsForHalo: menu  hand: aHand.
	menu defaultTarget: self.
	self addCustomHaloMenuItems: menu hand: aHand.
	menu defaultTarget: aHand.
	^ menu
! !

!Morph methodsFor: 'meta-actions' stamp: 'jmv 5/17/2009 23:42'!
buildMetaMenu: evt 
	"Build the morph menu. This menu has two sections. The first section contains commands that are handled by the hand; the second contains commands handled by the argument morph."

	| menu |
	menu := MenuMorph new defaultTarget: self.
	menu addStayUpIcons.
	menu add: 'grab' translated action: #grabMorph:.
	menu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:.
	self maybeAddCollapseItemTo: menu.
	menu add: 'delete' translated action: #dismissMorph:.
	menu addLine.
	menu add: 'copy text' translated action: #clipText.
	menu addLine.
	menu add: 'go behind' translated action: #goBehind.
	menu add: 'add halo' translated action: #addHalo:.
	menu add: 'duplicate' translated action: #maybeDuplicateMorph:.
	self addEmbeddingMenuItemsTo: menu hand: evt hand.
	menu add: 'resize' translated action: #resizeMorph:.
	"Give the argument control over what should be done about fill styles"
	self addFillStyleMenuItems: menu hand: evt hand.
	menu 
		addUpdating: #hasClipSubmorphsString
		target: self
		selector: #changeClipSubmorphs
		argumentList: #().
	menu addLine.
	(self morphsAt: evt position) size > 1 
		ifTrue: 
			[menu 
				add: 'submorphs...' translated
				target: self
				selector: #invokeMetaMenuAt:event:
				argument: evt position].
	menu addLine.
	menu 
		add: 'inspect' translated
		selector: #inspectAt:event:
		argument: evt position.
	menu add: 'explore' translated action: #explore.
	menu add: 'browse hierarchy' translated action: #browseHierarchy.
	menu add: 'show actions' translated action: #showActions.
	menu addLine.
	self addDebuggingItemsTo: menu hand: evt hand.
	self addCustomMenuItems: menu hand: evt hand.
	^menu! !


!BorderedMorph methodsFor: 'accessing' stamp: 'jmv 5/17/2009 22:57'!
borderStyle
	"Work around the borderWidth/borderColor pair"

	| style |
	borderColor ifNil: [^BorderStyle default].
	borderWidth isZero ifTrue: [^BorderStyle default].
	style := borderStyle ifNil: [BorderStyle default].
	(borderWidth = style width and: 
			["Hah!! Try understanding this..."

			borderColor == style style or: 
					["#raised/#inset etc"

					#simple == style style and: [borderColor = style color]]]) 
		ifFalse: 
			[style := borderColor isColor 
				ifTrue: [BorderStyle width: borderWidth color: borderColor]
				ifFalse: [(BorderStyle perform: borderColor) width: borderWidth	"argh."].
			borderStyle _ style].
	^style trackColorFrom: self! !

!BorderedMorph methodsFor: 'accessing' stamp: 'jmv 5/17/2009 22:57'!
borderStyle: aBorderStyle 
	"Work around the borderWidth/borderColor pair"

	aBorderStyle = self borderStyle ifTrue: [^self].
	"secure against invalid border styles"
	(self canDrawBorder: aBorderStyle) 
		ifFalse: 
			["Replace the suggested border with a simple one"

			^self borderStyle: (BorderStyle width: aBorderStyle width
						color: (aBorderStyle trackColorFrom: self) color)].
	aBorderStyle width = self borderStyle width ifFalse: [self changed].
	(aBorderStyle isNil or: [aBorderStyle == BorderStyle default]) 
		ifTrue: [
			borderStyle _ nil.
			borderWidth := 0.
			^self changed].
	borderStyle _ aBorderStyle.
	borderStyle _ aBorderStyle.
	borderWidth := aBorderStyle width.
	borderColor := aBorderStyle style == #simple 
				ifTrue: [aBorderStyle color]
				ifFalse: [aBorderStyle style].
	self changed! !

!BorderedMorph methodsFor: 'accessing' stamp: 'jmv 5/17/2009 23:01'!
borderStyleForSymbol: aStyleSymbol
	"Answer a suitable BorderStyle for me of the type represented by a given symbol"

	| aStyle existing |
	aStyle _ BorderStyle borderStyleForSymbol: aStyleSymbol asSymbol.
	aStyle ifNil: [self error: 'bad style'].
	existing _ self borderStyle.
	aStyle width: existing width;
		baseColor: existing baseColor.
	^ (self canDrawBorder: aStyle)
		ifTrue:
			[aStyle]
		ifFalse:
			[nil]! !

!BorderedMorph methodsFor: 'accessing' stamp: 'jmv 5/17/2009 23:08'!
setBorderStyle: aSymbol
	"Set the border style of my costume"

	| aStyle |
	aStyle _ self borderStyleForSymbol: aSymbol.
	aStyle ifNil: [^ self].
	(self canDrawBorder: aStyle)
		ifTrue:
			[self borderStyle: aStyle]! !

!BorderedMorph methodsFor: 'drawing' stamp: 'jmv 5/17/2009 23:02'!
drawOn: aCanvas

	aCanvas fillRectangle: self bounds fillStyle: self fillStyle borderStyle: self borderStyle.
! !

!BorderedMorph methodsFor: 'geometry' stamp: 'jmv 5/17/2009 23:13'!
innerBounds
	"Return the inner rectangle enclosed by the bounds of this morph excluding the space taken by its borders. For an unbordered morph, this is just its bounds."

	^ self bounds insetBy: self borderWidth! !

!BorderedMorph methodsFor: 'menu' stamp: 'jmv 5/17/2009 23:40'!
addBorderStyleMenuItems: aMenu hand: aHandMorph
	"Add border-style menu items"

	| subMenu |
	subMenu _ MenuMorph new defaultTarget: self.
	subMenu addTitle: 'border' translated.
	subMenu addStayUpIcons.
	subMenu addList: 
		{{'border color...' translated. #changeBorderColor:}.
		{'border width...' translated. #changeBorderWidth:}}.
	subMenu addLine.
	BorderStyle borderStyleChoices do:
		[:sym | (self borderStyleForSymbol: sym)
			ifNotNil:
				[subMenu add: sym target: self selector: #setBorderStyle: argument: sym]].
	aMenu add: 'border style...' translated subMenu: subMenu
! !

!BorderedMorph methodsFor: 'caching' stamp: 'jmv 5/17/2009 23:04'!
releaseCachedState
	"Release any state that can be recomputed on demand, such as the pixel values for a color gradient or the editor state for a TextMorph. This method may be called to save space when a morph becomes inaccessible. Implementations of this method should do 'super releaseCachedState'."
	
	super releaseCachedState.
	self borderStyle releaseCachedState.
! !


!BrowserCommentTextMorph methodsFor: 'updating' stamp: 'jmv 5/17/2009 22:52'!
noteNewOwner: win
	super noteNewOwner: win.
	browserWindow _ win.
	win ifNil: [ ^self ].
	browserLowerPane _ win
		submorphThat: [ :m | 
			m isAlignmentMorph and: [ m layoutFrame bottomFraction = 1 ]]
		ifNone: []! !

!BrowserCommentTextMorph methodsFor: 'accessing' stamp: 'jmv 5/17/2009 22:51'!
lowerPane
	"Answer the AlignmentMorph that I live beneath"
	^browserLowerPane! !

!BrowserCommentTextMorph methodsFor: 'accessing' stamp: 'jmv 5/17/2009 22:51'!
window
	^self owner ifNil: [ browserWindow ].! !


!ImageMorph methodsFor: 'drawing' stamp: 'jmv 5/17/2009 23:11'!
drawOn: aCanvas

	self isOpaque
		ifTrue:[aCanvas drawImage: image at: self innerBounds origin]
		ifFalse:[aCanvas translucentImage: image at: self innerBounds origin]! !


!MenuItemMorph methodsFor: 'events' stamp: 'jmv 5/17/2009 23:27'!
invokeWithEvent: evt
	"Perform the action associated with the given menu item."

	| selArgCount w |
	self isEnabled ifFalse: [^ self].
	owner ifNotNil: [
		self flag: #workAround. "The tile system invokes menus straightforwardly so the menu might not be in the world."
		(w _ self world) ifNotNil:[
			owner deleteIfPopUp: evt.
			"Repair damage before invoking the action for better feedback"
			w displayWorldSafely]].
	selector ifNil:[^self].
	Cursor normal showWhile: [  "show cursor in case item opens a new MVC window"
		(selArgCount _ selector numArgs) = 0
			ifTrue:
				[target perform: selector]
			ifFalse:
				[selArgCount = arguments size
					ifTrue: [target perform: selector withArguments: arguments]
					ifFalse: [target perform: selector withArguments: (arguments copyWith: evt)]]].! !


!MenuMorph methodsFor: 'construction' stamp: 'jmv 5/17/2009 23:38'!
addStayUpIcons
	| closeBox pinBox w |
	(self valueOfProperty: #hasStayUpIcons ifAbsent: [ false ])
		ifTrue: [
		 	self removeProperty: #needsStayUpIcons.
			^self ].
	titleMorph ifNil: [
		"Title not yet there. Flag ourself, so this method is called again when adding title."
		self setProperty: #needsStayUpIcons toValue: true.
		^ self].
	closeBox := IconicButton new target: self;
		actionSelector: #delete;
		labelGraphic: self class closeBoxImage;
		color: Color transparent;
		extent: 14 @ 16;
		borderWidth: 0.
	pinBox := IconicButton new target: self;
		actionSelector: #stayUp:;
		arguments: {true};
		labelGraphic: self class pushPinImage;
		color: Color transparent;
		extent: 14 @ 15;
		borderWidth: 0.
	w _ (titleMorph hasSubmorphs ifTrue: [ titleMorph firstSubmorph width ] ifFalse: [ 0 ]) + 42.
	self addMorphFront: 
		(AlignmentMorph proportional
			height: (titleMorph height max: 19);
			width: w;	"Make room for buttons"
			color: Color transparent;
			addMorph: closeBox
				fullFrame: (LayoutFrame fractions: (0@0 corner: 0@1) offsets: (0@0 corner: 16@0));
			addMorph: titleMorph
				fullFrame: (LayoutFrame fractions: (0@0 corner: 1@1) offsets: (17@0 corner: -17@0));
			addMorph: pinBox
				fullFrame: (LayoutFrame fractions: (1@0 corner: 1@1) offsets: (-16@0 corner: 0@0))).

	self setProperty: #hasStayUpIcons toValue: true.
	self removeProperty: #needsStayUpIcons! !

!MenuMorph methodsFor: 'construction' stamp: 'jmv 5/17/2009 23:36'!
addTitle: aString
	"Add a title line at the top of this menu Make aString its initial 
	contents.  
	If aSelector is not nil, then periodically obtain fresh values for its 
	contents by sending aSelector to aTarget.."

	| s p w |
	
	titleMorph := RectangleMorph new.
	self setTitleParametersFor: titleMorph.
	p _ titleMorph position + (4@2).
	(aString asString findTokens: String cr) do: [ :line | 
		s _ StringMorph new
			contents: line;
			font: Preferences standardMenuFont.
		s position: p.
		titleMorph addMorphBack: s.
		p _ p + (0@s height) ].
	w _ titleMorph submorphs inject: 0 into: [ :prev :each |
		prev max: each width ].
	titleMorph height: p y; width: w + 8.
	self addMorphFront: titleMorph.
	
	(self hasProperty: #needsStayUpIcons) ifTrue: [ self addStayUpIcons ]! !


!MenuMorph class methodsFor: 'example' stamp: 'jmv 5/17/2009 23:42'!
example
	"MenuMorph example openInWorld"

	| menu |
	menu _ MenuMorph new.
	menu addStayUpIcons.
	menu add: 'apples' action: #apples.
	menu add: 'oranges' action: #oranges.
	menu addLine.
	menu addLine.  "extra lines ignored"
	menu add: 'peaches' action: #peaches.
	menu addLine.
	menu add: 'pears' action: #pears.
	menu addLine.
	^ menu
! !

!MenuMorph class methodsFor: 'example' stamp: 'jmv 5/17/2009 23:42'!
example2
	"MenuMorph example2 openInWorld"

	| menu |
	menu _ MenuMorph entitled: 'sdfasdfa sfda sdf as df as fd'.
	menu addStayUpIcons.
	menu add: 'apples' action: #apples.
	menu add: 'oranges' action: #oranges.
	menu addLine.
	menu addLine.  "extra lines ignored"
	menu add: 'peaches' action: #peaches.
	menu addLine.
	menu add: 'pears' action: #pears.
	menu addLine.
	^ menu
! !


!Preferences class methodsFor: 'personalization' stamp: 'jmv 5/17/2009 23:42'!
personalizeUserMenu: aMenu
	"The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world.  In this method, you are invited to add items to the menu as per personal preferences.
	The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates"
	
	aMenu addTitle: 'personal' translated.  "Remove or modify this as per personal choice"

	aMenu addStayUpIcons.
	aMenu add: 'about this system...' translated target: Smalltalk action: #aboutThisSystem! !


!StringHolder methodsFor: 'message list menu' stamp: 'jmv 5/17/2009 23:42'!
offerDurableMenuFrom: menuRetriever shifted: aBoolean
	"Pop up (morphic only) a menu whose target is the receiver and whose contents are provided by sending the menuRetriever to the receiver.  The menuRetriever takes two arguments: a menu, and a boolean representing the shift state; put a stay-up item at the top of the menu."

	| aMenu |
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addStayUpIcons.
	self perform: menuRetriever with: aMenu with: aBoolean.
		aMenu popUpInWorld! !


!CodeHolder methodsFor: 'what to show' stamp: 'jmv 5/17/2009 23:41'!
offerWhatToShowMenu
	"Offer a menu governing what to show"

	 | aMenu  |
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addTitle: 'What to show'.
	aMenu addStayUpIcons.
	self addContentsTogglesTo: aMenu.
	aMenu popUpInWorld 
! !


!Browser methodsFor: 'message functions' stamp: 'jmv 5/17/2009 23:41'!
shiftedMessageListMenu: aMenu
	"Fill aMenu with the items appropriate when the shift key is held down"

	aMenu addStayUpIcons.
	aMenu addList: #(
		('toggle diffing (D)'						toggleDiffing)
		('implementors of sent messages'			browseAllMessages)
		-
		('local senders of...'						browseLocalSendersOfMessages)
		('local implementors of...'				browseLocalImplementors)
		-
		('spawn sub-protocol'					spawnProtocol)
		('spawn full protocol'					spawnFullProtocol)
		-
		('sample instance'						makeSampleInstance)
		('inspect instances'						inspectInstances)
		('inspect subinstances'					inspectSubInstances)).

	self addExtraShiftedItemsTo: aMenu.
	aMenu addList: #(
		-
		('change category...'					changeCategory)).

	self canShowMultipleMessageCategories ifTrue: [aMenu addList:
		 #(('show category (C)'						showHomeCategory))].
	aMenu addList: #(
		-
		('change sets with this method'			findMethodInChangeSets)
		('revert to previous version'				revertToPreviousVersion)
		('remove from current change set'		removeFromCurrentChanges)
		('revert & remove from changes'		revertAndForget)
		('add to current change set'				adoptMessageInCurrentChangeset)
		('copy up or copy down...'				copyUpOrCopyDown)
		-
		('more...' 								unshiftedYellowButtonActivity)).
	^ aMenu
! !


!ChangeList methodsFor: 'menu actions' stamp: 'jmv 5/17/2009 23:40'!
changeListMenu: aMenu
	"Fill aMenu up so that it comprises the primary changelist-browser menu"

	aMenu addTitle: 'change list'.
	aMenu addStayUpIcons.

	aMenu addList: #(

	('fileIn selections'							fileInSelections						'import the selected items into the image')
	('fileOut selections...	'						fileOutSelections						'create a new file containing the selected items')
	-
	('compare to current'						compareToCurrentVersion			'open a separate window which shows the text differences between the on-file version and the in-image version.' )
	('toggle diffing (D)'							toggleDiffing						'start or stop showing diffs in the code pane.')
	-
	('select conflicts with any changeset'		selectAllConflicts					'select methods in the file which also occur in any change-set in the system')
	('select conflicts with current changeset'	selectConflicts						'select methods in the file which also occur in the current change-set')
	('select conflicts with...'						selectConflictsWith					'allows you to designate a file or change-set against which to check for code conflicts.')
	-
	('select unchanged methods'					selectUnchangedMethods				'select methods in the file whose in-image versions are the same as their in-file counterparts' )
	('select methods equivalent to current'		selectEquivalentMethods				'select methods in the file whose in-image versions have the same behavior as their in-file counterparts' )
	('select new methods'						selectNewMethods					'select methods in the file that do not current occur in the image')
	('select methods for this class'				selectMethodsForThisClass			'select all methods in the file that belong to the currently-selected class')

	-
	('select all (a)'								selectAll								'select all the items in the list')
	('deselect all'								deselectAll							'deselect all the items in the list')
	('invert selections'							invertSelections						'select every item that is not currently selected, and deselect every item that *is* currently selected')
	-
	('browse all versions of single selection'			browseVersions		'open a version browser showing the versions of the currently selected method')
	('browse all versions of selections'			browseAllVersionsOfSelections		'open a version browser showing all the versions of all the selected methods')
	('browse current versions of selections'		browseCurrentVersionsOfSelections	'open a message-list browser showing the current (in-image) counterparts of the selected methods')
	('destroy current methods of selections'		destroyCurrentCodeOfSelections		'remove (*destroy*) the in-image counterparts of all selected methods')
	-
	('remove doIts'								removeDoIts							'remove all items that are doIts rather than methods')
	('remove older versions'						removeOlderMethodVersions			'remove all but the most recent versions of methods in the list')
	('remove up-to-date versions'				removeExistingMethodVersions		'remove all items whose code is the same as the counterpart in-image code')
	('remove empty class comments'				removeEmptyClassComments		'remove all empty class comments')
	('remove selected items'						removeSelections					'remove the selected items from the change-list')
	('remove unselected items'					removeNonSelections					'remove all the items not currently selected from the change-list')).

	^ aMenu

! !


!ChangeSorter methodsFor: 'changeSet menu' stamp: 'jmv 5/17/2009 23:40'!
changeSetMenu: aMenu shifted: isShifted 
	"Set up aMenu to hold commands for the change-set-list pane.  This could be for a single or double changeSorter"

	isShifted ifTrue: [^ self shiftedChangeSetMenu: aMenu].
	aMenu title: 'Change Set'.
	aMenu addStayUpIcons.

	aMenu add: 'make changes go to me (m)' action: #newCurrent.
	aMenu addLine.
	aMenu add: 'new change set... (n)' action: #newSet.
	aMenu add: 'find...(f)' action: #findCngSet.
	aMenu add: 'select change set...' action: #chooseCngSet.
	aMenu addLine.
	aMenu add: 'rename change set (r)' action: #rename.
	aMenu add: 'file out (o)' action: #fileOut.
	aMenu add: 'browse methods (b)' action: #browseChangeSet.
	aMenu add: 'browse change set (B)' action: #openChangeSetBrowser.
	aMenu addLine.
	parent
		ifNotNil: 
			[aMenu add: 'copy all to other side (c)' action: #copyAllToOther.
			aMenu add: 'submerge into other side' action: #submergeIntoOtherSide.
			aMenu add: 'subtract other side (-)' action: #subtractOtherSide.
			aMenu addLine].
	myChangeSet hasPreamble
		ifTrue: 
			[aMenu add: 'edit preamble (p)' action: #addPreamble.
			aMenu add: 'remove preamble' action: #removePreamble]
		ifFalse: [aMenu add: 'add preamble (p)' action: #addPreamble].
	myChangeSet hasPostscript
		ifTrue: 
			[aMenu add: 'edit postscript...' action: #editPostscript.
			aMenu add: 'remove postscript' action: #removePostscript]
		ifFalse: [aMenu add: 'add postscript...' action: #editPostscript].
	aMenu addLine.

	aMenu add: 'destroy change set (x)' action: #remove.
	aMenu addLine.
	aMenu add: 'more...' action: #offerShiftedChangeSetMenu.
	^ aMenu! !

!ChangeSorter methodsFor: 'changeSet menu' stamp: 'jmv 5/17/2009 23:40'!
shiftedChangeSetMenu: aMenu
	"Set up aMenu to hold items relating to the change-set-list pane when the shift key is down"

	aMenu title: 'Change set (shifted)'.
	aMenu addStayUpIcons.

	"CONFLICTS SECTION"
	aMenu add: 'conflicts with other change sets' action: #browseMethodConflicts.
	aMenu balloonTextForLastItem: 
'Browse all methods that occur both in this change set and in at least one other change set.'.
	parent ifNotNil:
		[aMenu add: 'conflicts with change set opposite' action: #methodConflictsWithOtherSide.
			aMenu balloonTextForLastItem: 
'Browse all methods that occur both in this change set and in the one on the opposite side of the change sorter.'.

			aMenu add: 'conflicts with category opposite' action: #methodConflictsWithOppositeCategory.
			aMenu balloonTextForLastItem: 
'Browse all methods that occur both in this change set and in ANY change set in the category list on the opposite side of this change sorter, other of course than this change set itself.  (Caution -- this could be VERY slow)'].
	aMenu addLine.

	"CHECKS SECTION"
	aMenu add: 'check for slips' action: #lookForSlips.
	aMenu balloonTextForLastItem: 
'Check this change set for halts and references to Transcript.'.

	aMenu add: 'check for unsent messages' action: #checkForUnsentMessages.
	aMenu balloonTextForLastItem:
'Check this change set for messages that are not sent anywhere in the system'.

	aMenu add: 'check for uncommented methods' action: #checkForUncommentedMethods.
	aMenu balloonTextForLastItem:
'Check this change set for methods that do not have comments'.

	aMenu add: 'check for uncommented classes' action: #checkForUncommentedClasses.
	aMenu balloonTextForLastItem:
'Check for classes with code in this changeset which lack class comments'.

	Utilities authorInitialsPerSe isEmptyOrNil ifFalse:
		[aMenu add: 'check for other authors' action: #checkForAlienAuthorship.
		aMenu balloonTextForLastItem:
'Check this change set for methods whose current authoring stamp does not start with "', Utilities authorInitials, '"'.

	aMenu add: 'check for any other authors' action: #checkForAnyAlienAuthorship.
	aMenu balloonTextForLastItem:
'Check this change set for methods any of whose authoring stamps do not start with "', Utilities authorInitials, '"'].

	aMenu add: 'check for uncategorized methods' action: #checkForUnclassifiedMethods.
	aMenu balloonTextForLastItem:
'Check to see if any methods in the selected change set have not yet been assigned to a category.  If any are found, open a browser on them.'.
	aMenu addLine.

	aMenu add: 'inspect change set' action: #inspectChangeSet.
	aMenu balloonTextForLastItem: 
'Open an inspector on this change set. (There are some details in a change set which you don''t see in a change sorter.)'.

	aMenu add: 'update' action: #update.
	aMenu balloonTextForLastItem: 
'Update the display for this change set.  (This is done automatically when you activate this window, so is seldom needed.)'.

	aMenu add: 'promote to top of list' action: #promoteToTopChangeSet.
	aMenu balloonTextForLastItem:
'Make this change set appear first in change-set lists in all change sorters.'.

	aMenu add: 'trim history' action: #trimHistory.
	aMenu balloonTextForLastItem: 
' Drops any methods added and then removed, as well as renaming and reorganization of newly-added classes.  NOTE: can cause confusion if later filed in over an earlier version of these changes'.

	aMenu add: 'view affected class categories' action: #viewAffectedClassCategories.
	aMenu balloonTextForLastItem: ' Show class categories affected by any contained change'.
	
	aMenu add: 'remove contained in class categories...' action: #removeContainedInClassCategories.
	aMenu balloonTextForLastItem: ' Drops any changes in given class categories'.

	aMenu add: 'clear this change set' action: #clearChangeSet.
	aMenu balloonTextForLastItem: 
'Reset this change set to a pristine state where it holds no information. CAUTION: this is destructive and irreversible!!'.

	aMenu add: 'uninstall this change set' action: #uninstallChangeSet.
	aMenu balloonTextForLastItem: 
'Attempt to uninstall this change set. CAUTION: this may not work completely and is irreversible!!'.

	aMenu addLine.
	aMenu add: 'file into new...' action: #fileIntoNewChangeSet.
	aMenu balloonTextForLastItem: 
'Load a fileout from disk and place its changes into a new change set (seldom needed -- much better to do this from a file-list browser these days.)'.

	aMenu add: 'reorder all change sets' action: #reorderChangeSets.
	aMenu balloonTextForLastItem:
'Applies a standard reordering of all change-sets in the system -- at the bottom will come the sets that come with the release; next will come all the numbered updates; finally, at the top, will come all other change sets'.

	aMenu addLine.

	aMenu add: 'more...' action: #offerUnshiftedChangeSetMenu.
	aMenu balloonTextForLastItem: 
'Takes you back to the primary change-set menu.'.

	^ aMenu! !

!ChangeSorter methodsFor: 'class list' stamp: 'jmv 5/17/2009 23:40'!
classListMenu: aMenu shifted: shifted
	"Fill aMenu with items appropriate for the class list"

	aMenu title: 'class list'.
	aMenu addStayUpIcons.
	(parent notNil and: [shifted not])
		ifTrue: [aMenu addList: #( "These two only apply to dual change sorters"
			('copy class chgs to other side'			copyClassToOther)	
			('move class chgs to other side'			moveClassToOther))].

	aMenu addList: (shifted
		ifFalse: [#(
			-
			('delete class from change set (d)'		forgetClass)
			('remove class from system (x)'			removeClass)
			-
			('browse full (b)'						browseMethodFull)
			('browse hierarchy (h)'					spawnHierarchy)
			('browse protocol (p)'					browseFullProtocol)
			-
			('fileOut'								fileOutClass)
			-
			('inst var refs...'						browseInstVarRefs)
			('inst var defs...'						browseInstVarDefs)
			('class var refs...'						browseClassVarRefs)
			('class vars'								browseClassVariables)
			('class refs (N)'							browseClassRefs)
			-
			('more...'								offerShiftedClassListMenu))]

		ifTrue: [#(
			-
			('unsent methods'						browseUnusedMethods)
			('unreferenced inst vars'				showUnreferencedInstVars)
			('unreferenced class vars'				showUnreferencedClassVars)
			-
			('sample instance'						makeSampleInstance)
			('inspect instances'						inspectInstances)
			('inspect subinstances'					inspectSubInstances)
			-
			('more...'								offerUnshiftedClassListMenu ))]).
	^ aMenu! !

!ChangeSorter methodsFor: 'message list' stamp: 'jmv 5/17/2009 23:40'!
messageMenu: aMenu shifted: shifted
	"Fill aMenu with items appropriate for the message list; could be for a single or double changeSorter"

	shifted ifTrue: [^ self shiftedMessageMenu: aMenu].

	aMenu title: 'message list'.
	aMenu addStayUpIcons.

	parent ifNotNil:
		[aMenu addList: #(
			('copy method to other side'			copyMethodToOther)
			('move method to other side'			moveMethodToOther))].

	aMenu addList: #(
			('delete method from changeSet (d)'	forget)
			-
			('remove method from system (x)'	removeMessage)
				-
			('browse full (b)'					browseMethodFull)
			('browse hierarchy (h)'				spawnHierarchy)
			('browse method (O)'				openSingleMessageBrowser)
			('browse protocol (p)'				browseFullProtocol)
			-
			('fileOut'							fileOutMessage)
			-
			('senders of... (n)'					browseSendersOfMessages)
			('implementors of... (m)'				browseMessages)
			('inheritance (i)'					methodHierarchy)
			('versions (v)'						browseVersions)
			-
			('more...'							shiftedYellowButtonActivity)).
	^ aMenu
! !


!ChangeSetBrowser methodsFor: 'menu' stamp: 'jmv 5/17/2009 23:40'!
shiftedChangeSetMenu: aMenu
	"Set up aMenu to hold items relating to the change-set-list pane when the shift key is down"

	aMenu title: 'Change set (shifted)'.
	aMenu addStayUpIcons.
	aMenu add: 'conflicts with other change sets' action: #browseMethodConflicts.
	aMenu balloonTextForLastItem: 
'Browse all methods that occur both in this change set and in at least one other change set.'.

	aMenu addLine.
	aMenu add: 'check for slips' action: #lookForSlips.
	aMenu balloonTextForLastItem: 
'Check this change set for halts and references to Transcript.'.

	aMenu add: 'check for unsent messages' action: #checkForUnsentMessages.
	aMenu balloonTextForLastItem:
'Check this change set for messages that are not sent anywhere in the system'.

	aMenu add: 'check for uncommented methods' action: #checkForUncommentedMethods.
	aMenu balloonTextForLastItem:
'Check this change set for methods that do not have comments'.

	aMenu add: 'check for uncommented classes' action: #checkForUncommentedClasses.
	aMenu balloonTextForLastItem:
'Check for classes with code in this changeset which lack class comments'.


	Utilities authorInitialsPerSe isEmptyOrNil ifFalse:
		[aMenu add: 'check for other authors' action: #checkForAlienAuthorship.
		aMenu balloonTextForLastItem:
'Check this change set for methods whose current authoring stamp does not start with "', Utilities authorInitials, '"'.

		aMenu add: 'check for any other authors' action: #checkForAnyAlienAuthorship.
		aMenu balloonTextForLastItem:
'Check this change set for methods any of whose previous authoring stamps do not start with "', Utilities authorInitials, '"'].

	aMenu add: 'check for uncategorized methods' action: #checkForUnclassifiedMethods.
	aMenu balloonTextForLastItem:
'Check to see if any methods in the selected change set have not yet been assigned to a category.  If any are found, open a browser on them.'.
	aMenu addLine.

	aMenu add: 'inspect change set' action: #inspectChangeSet.
	aMenu balloonTextForLastItem: 
'Open an inspector on this change set. (There are some details in a change set which you don''t see in a change sorter.)'.

	aMenu add: 'update' action: #update.
	aMenu balloonTextForLastItem: 
'Update the display for this change set.  (This is done automatically when you activate this window, so is seldom needed.)'.

	aMenu add: 'trim history' action: #trimHistory.
	aMenu balloonTextForLastItem: 
' Drops any methods added and then removed, as well as renaming and reorganization of newly-added classes.  NOTE: can cause confusion if later filed in over an earlier version of these changes'.

	aMenu add: 'clear this change set' action: #clearChangeSet.
	aMenu balloonTextForLastItem: 
'Reset this change set to a pristine state where it holds no information. CAUTION: this is destructive and irreversible!!'.

	aMenu add: 'uninstall this change set' action: #uninstallChangeSet.
	aMenu balloonTextForLastItem: 
'Attempt to uninstall this change set. CAUTION: this may not work completely and is irreversible!!'.

	aMenu addLine.

	aMenu add: 'more...' action: #offerUnshiftedChangeSetMenu.
	aMenu balloonTextForLastItem: 
'Takes you back to the primary change-set menu.'.

	^ aMenu! !


!FileList methodsFor: 'file list menu' stamp: 'jmv 5/17/2009 23:40'!
fullFileListMenu: aMenu shifted: aBoolean
	"Fill the menu with all possible items for the file list pane, regardless of selection."

	| lastProvider |
	aMenu title: 'all possible file operations'.
	aMenu addStayUpIcons.

	lastProvider _ nil.
	(self itemsForFile: 'a.*') do: [ :svc |
		(lastProvider notNil and: [svc provider ~~ lastProvider])
			ifTrue: [ aMenu addLine ].
		svc addServiceFor: self toMenu: aMenu.
		aMenu submorphs last setBalloonText: svc description.
		lastProvider _ svc provider.
		svc addDependent: self.
	].

	^aMenu! !


!Inspector methodsFor: 'menu commands' stamp: 'jmv 5/17/2009 23:40'!
fieldListMenu: aMenu
	"Arm the supplied menu with items for the field-list of the receiver"

	aMenu addStayUpIcons.

	aMenu addList: #(
		('inspect (i)'						inspectSelection)
		('explore (I)'					exploreSelection)).

	self addCollectionItemsTo: aMenu.

	aMenu addList: #(
		-
		('method refs to this inst var'		referencesToSelection)
		('methods storing into this inst var'	defsOfSelection)
		('objects pointing to this value'		objectReferencesToSelection)
		('chase pointers'						chasePointers)
		('explore pointers'					explorePointers)
		-
		('browse full (b)'						browseMethodFull)
		('browse class'						browseClass)
		('browse hierarchy (h)'				classHierarchy)
		('browse protocol (p)'				browseFullProtocol)
		-
		('inst var refs...'						browseInstVarRefs)
		('inst var defs...'						browseInstVarDefs)
		('class var refs...'					classVarRefs)
		('class variables'						browseClassVariables)
		('class refs (N)'						browseClassRefs)
		-
		('copy name (c)'						copyName)		
		('basic inspect'						inspectBasic)).

	^ aMenu

! !


!DictionaryInspector methodsFor: 'menu' stamp: 'jmv 5/17/2009 23:41'!
dictionaryMenu: aMenu
	"Set up the key-list menu for a dictionary inspector"

	aMenu title: 'Dictionary key'.
	aMenu addStayUpIcons.
	^ aMenu addList: #(
		('inspect'						inspectSelection)
		('copy name'					copyName)
		('references'					selectionReferences)
		('objects pointing to this value'	objectReferencesToSelection)
		('senders of this key'			sendersOfSelectedKey)
		-
		('refresh view'					calculateKeyArray)
		-
		('add key'						addEntry)
		('rename key'					renameEntry)
		('remove'						removeSelection)
		-
		('basic inspect'					inspectBasic))! !


!MessageSet methodsFor: 'filtering' stamp: 'jmv 5/17/2009 23:42'!
filterMessageList
	"Allow the user to refine the list of messages."

	| aMenu evt |
	messageList size <= 1 
		ifTrue: [^self inform: 'this is not a propitious filtering situation'].

	"would like to get the evt coming in but thwarted by the setInvokingView: circumlocution"
	evt := self currentWorld activeHand lastEvent.
	aMenu := MenuMorph new defaultTarget: self.
	aMenu addTitle: 'Filter by only showing...'.
	aMenu addStayUpIcons.
	aMenu 
		addList: #(#('unsent messages' #filterToUnsentMessages 'filter to show only messages that have no senders') #- #('messages that send...' #filterToSendersOf 'filter to show only messages that send a selector I specify') #('messages that do not send...' #filterToNotSendersOf 'filter to show only messages that do not send a selector I specify') #- #('messages whose selector is...' #filterToImplementorsOf 'filter to show only messages with a given selector I specify') #('messages whose selector is NOT...' #filterToNotImplementorsOf 'filter to show only messages whose selector is NOT a seletor I specify') #- #('messages in current change set' #filterToCurrentChangeSet 'filter to show only messages that are in the current change set') #('messages not in current change set' #filterToNotCurrentChangeSet 'filter to show only messages that are not in the current change set') #- #('messages in any change set' #filterToAnyChangeSet 'filter to show only messages that occur in at least one change set') #('messages not in any change set' #filterToNotAnyChangeSet 'filter to show only messages that do not occur in any change set in the system') #- #('messages authored by me' #filterToCurrentAuthor 'filter to show only messages whose authoring stamp has my initials') #('messages not authored by me' #filterToNotCurrentAuthor 'filter to show only messages whose authoring stamp does not have my initials') #- #('messages logged in .changes file' #filterToMessagesInChangesFile 'filter to show only messages whose latest source code is logged in the .changes file') #('messages only in .sources file' #filterToMessagesInSourcesFile 'filter to show only messages whose latest source code is logged in the .sources file') #- #('messages with prior versions' #filterToMessagesWithPriorVersions 'filter to show only messages that have at least one prior version') #('messages without prior versions' #filterToMessagesWithoutPriorVersions 'filter to show only messages that have no prior versions') #- #('uncommented messages' #filterToUncommentedMethods 'filter to show only messages that do not have comments at the beginning') #('commented messages' #filterToCommentedMethods 'fileter to show only messages that have comments at the beginning') #- #('messages that...' #filterToMessagesThat 'let me type in a block taking a class and a selector, which will specify yea or nay concerning which elements should remain in the list')).
	aMenu popUpInWorld: evt hand world! !


!SystemWindow methodsFor: 'drawing' stamp: 'jmv 5/19/2009 11:19'!
drawOn: aCanvas

	| titleColor |
	super drawOn: aCanvas.

	titleColor _ self isTopWindow
		ifTrue: [ self paneColorToUse paler ]
		ifFalse: [ self paneColorToUse ].

	aCanvas
		frameAndFillRectangle: self titleAreaRect
		fillColor: titleColor
		borderWidth: borderWidth
		borderColor: titleColor.

	aCanvas
		drawString: labelString
		in: self labelRectangle
		font: Preferences windowTitleFont
		color: Color black! !

!SystemWindow methodsFor: 'events' stamp: 'jmv 5/17/2009 22:35'!
handlesMouseDown: evt 
	"If I am not the topWindow, then I will only respond to dragging by the title bar.
	Any other click will only bring me to the top"

	(self titleAreaRect containsPoint: evt cursorPoint)
		ifTrue: [^ true].
	^ false! !

!SystemWindow methodsFor: 'events' stamp: 'jmv 5/17/2009 22:35'!
mouseMove: evt
	"Handle a mouse-move event"

	| cp |
	cp _ evt cursorPoint.
	self valueOfProperty: #clickPoint ifPresentDo: [:firstClick |
		((self titleAreaRect containsPoint: firstClick) and: [(cp dist: firstClick) > 3]) ifTrue: [
			"If this is a drag that started in the title bar, then pick me up"
			^ self isSticky ifFalse: [
				self fastFramingOn 
					ifTrue: [self doFastFrameDrag: firstClick]
					ifFalse: [evt hand grabMorph: self]]]]! !

!SystemWindow methodsFor: 'geometry' stamp: 'jmv 5/17/2009 22:38'!
labelRectangle
	"Actually the whole label area"

	| tl br e x0 y0 x1 y1 |
	tl _ bounds topLeft.
	br _ bounds bottomRight.
	e _ self boxExtent.
	x0 _ tl x + ( e x * 4 + 14).
	y0 _ tl y + 2.
	x1 _ br x - 1.
	y1 _ tl y + e y + 1.
	^x0@y0 corner: x1@y1
	
	
	
! !

!SystemWindow methodsFor: 'geometry' stamp: 'jmv 5/17/2009 22:35'!
titleAreaRect

	^ self innerBounds withHeight: self labelHeight.
! !

!SystemWindow methodsFor: 'initialization' stamp: 'jmv 5/17/2009 22:40'!
initializeLabelArea
	"Initialize the label area (titlebar) for the window."

	| spacing |
	spacing _ self boxExtent x + 2.

	self
		addMorph: (self createCloseBox position: 2@2);
		addMorph: (self createMenuBox position: spacing+2@2);
		addMorph: (self createExpandBox position: spacing*2+2@2);
		addMorph: (self createCollapseBox position: spacing*3+2@2)! !

!SystemWindow methodsFor: 'panes' stamp: 'jmv 5/17/2009 22:46'!
paneColor
	| cc |
	(cc := paneColor) ifNotNil: [^cc].
	Display depth > 2 
		ifTrue: [
			model ifNotNil: [
					model isInMemory 
						ifTrue: [
							cc := Color colorFrom: model class windowColor.
							Preferences alternativeWindowLook 
								ifTrue: [
									cc := (cc = Color lightYellow or: [cc = Color white]) 
										ifTrue: [Color gray: 0.67]
										ifFalse: [cc duller]]]].
			cc ifNil: [cc := paneMorphs isEmptyOrNil ifFalse: [paneMorphs first color]]].
	cc ifNil: [cc := Color white].
	self paneColor: cc.
	^cc! !

!SystemWindow methodsFor: 'panes' stamp: 'jmv 5/17/2009 22:48'!
paneColor: aColor
	paneColor _ aColor.
	(Preferences alternativeWindowLook and: [ aColor notNil ]) 
		ifTrue: [ self color: aColor veryMuchLighter ].
	self adoptPaneColor: aColor.! !

!SystemWindow methodsFor: 'change reporting' stamp: 'jmv 5/17/2009 22:35'!
invalidateTitleArea
	
	bounds ifNotNil: [
		self invalidRect: self titleAreaRect ]! !


!TheWorldMenu methodsFor: 'construction' stamp: 'jmv 5/17/2009 23:42'!
buildWorldMenu
	"Build the menu that is put up when the screen-desktop is clicked on"

	| menu |
	menu := MenuMorph new defaultTarget: self.
	menu commandKeyHandler: self.
	self colorForDebugging: menu.
	menu addStayUpIcons.
	self fillIn: menu
		from: { 
				{ 
					'restore display (r)'.
					{ 
						World.
						#restoreMorphicDisplay}.
					'repaint the screen -- useful for removing unwanted display artifacts, lingering cursors, etc.'}.
				nil}.
	Preferences simpleMenus 
		ifFalse: 
			[self fillIn: menu
				from: { 
						{ 
							'open...'.
							{ 
								self.
								#openWindow}}.
						{ 
							'windows...'.
							{ 
								self.
								#windowsDo}}.
						{ 
							'changes...'.
							{ 
								self.
								#changesDo}}}].
	self fillIn: menu
		from: { 
				{ 
					'help...'.
					{ 
						self.
						#helpDo}.
					'puts up a menu of useful items for updating the system, determining what version you are running, and much else'}.
				{ 
					'appearance...'.
					{ 
						self.
						#appearanceDo}.
					'put up a menu offering many controls over appearance.'}}.
	Preferences simpleMenus 
		ifFalse: 
			[self fillIn: menu
				from: { 
						{ 
							'do...'.
							{ 
								Utilities.
								#offerCommonRequests}.
							'put up an editible list of convenient expressions, and evaluate the one selected.'}}].
	self fillIn: menu
		from: { 
				nil.
				{ 
					'new morph...'.
					{ 
						self.
						#newMorph}.
					'Offers a variety of ways to create new objects'}.
				}.
	Preferences simpleMenus 
		ifFalse: 
			[self fillIn: menu
				from: { 
						{ 
							'debug...'.
							{ 
								self.
								#debugDo}.
							'a menu of debugging items'}}].
	self fillIn: menu
		from: { 
				nil.
				{ 
					'save'.
					{ 
						Smalltalk .
						#saveSession}.
					'save the current version of the image on disk'}.
				{ 
					'save as...'.
					{ 
						Smalltalk .
						#saveAs}.
					'save the current version of the image on disk under a new name.'}.
				{ 
					'save as new version'.
					{ 
						Smalltalk .
						#saveAsNewVersion}.
					'give the current image a new version-stamped name and save it under that name on disk.'}.
				{ 
					'save and quit'.
					{ 
						self.
						#saveAndQuit}.
					'save the current image on disk, and quit out of Squeak.'}.
				{ 
					'quit'.
					{ 
						self.
						#quitSession}.
					'quit out of Squeak.'}}.
	^menu! !

!TheWorldMenu methodsFor: 'mechanics' stamp: 'jmv 5/17/2009 23:42'!
menu: titleString
	"Create a menu with the given title, ready for filling"

	| menu |
	(menu _ MenuMorph entitled: titleString translated) 
		defaultTarget: self; 
		addStayUpIcons;
		commandKeyHandler: self.
	self colorForDebugging: menu.
	^ menu
! !


!Utilities class methodsFor: 'common requests' stamp: 'jmv 5/17/2009 23:42'!
offerCommonRequestsInMorphic
	"Offer up the common-requests menu.  If the user chooses one, then evaluate it, and -- provided the value is a number or string -- show it in the Transcript."

	"Utilities offerCommonRequests"

	| aMenu strings |
	(CommonRequestStrings == nil or: [CommonRequestStrings isKindOf: Array]) 
		ifTrue: [self initializeCommonRequestStrings].
	strings := CommonRequestStrings contents.
	aMenu := MenuMorph new.
	aMenu title: 'Common Requests' translated.
	aMenu addStayUpIcons.
	strings asString linesDo: 
			[:aString | 
			aString = '-' 
				ifTrue: [aMenu addLine]
				ifFalse: 
					[aString size = 0 ifTrue: [aString := ' '].
					aMenu 
						add: aString
						target: self
						selector: #eval:
						argument: aString]].
	aMenu addLine.
	aMenu 
		add: 'edit this list' translated
		target: self
		action: #editCommonRequestStrings.
	aMenu popUpInWorld: self currentWorld! !


!VersionsBrowser methodsFor: 'menu' stamp: 'jmv 5/17/2009 23:41'!
versionsMenu: aMenu
	"Fill aMenu with menu items appropriate to the receiver"

	aMenu title: 'Versions' translated.
	aMenu addStayUpIcons.

	listIndex > 0 ifTrue:[
		(list size > 1 ) ifTrue: [ aMenu addTranslatedList: #(
			('compare to current'		compareToCurrentVersion		'compare selected version to the current version')
			('compare to version...'	compareToOtherVersion		'compare selected version to another selected version'))].
		"Note: Revert to selected should be visible for lists of length one for having the ability to revert to an accidentally deleted method"
		 aMenu addTranslatedList: #(
			('revert to selected version'	fileInSelections					'resubmit the selected version, so that it becomes the current version') )].

	aMenu addTranslatedList: #(
		('remove from changes'		removeMethodFromChanges	'remove this method from the current change set, if present')
		('edit current method (O)'	openSingleMessageBrowser		'open a single-message browser on the current version of this method')		
		('find original change set'	findOriginalChangeSet			'locate the changeset which originally contained this version')
		-
		('toggle diffing (D)'			toggleDiffing					'toggle whether or not diffs should be shown here')
		('update list'				reformulateList					'reformulate the list of versions, in case it somehow got out of synch with reality')
		-
		('senders (n)'				browseSenders					'browse all senders of this selector')
		('implementors (m)'			browseImplementors			'browse all implementors of this selector')
		-
		('help...'					offerVersionsHelp				'provide an explanation of the use of this tool')).
											
	^aMenu! !


!ClassCommentVersionsBrowser methodsFor: 'menu' stamp: 'jmv 5/17/2009 23:40'!
versionsMenu: aMenu
	"Fill aMenu with menu items appropriate to the receiver"

	aMenu title: 'versions'.
	aMenu addStayUpIcons.
	^ aMenu addList: #(

		('compare to current'		compareToCurrentVersion		'compare selected version to the current version')
		('revert to selected version'	fileInSelections					'resubmit the selected version, so that it becomes the current version')
		('remove from changes'		removeMethodFromChanges		'remove this method from the current change set, if present')
		('edit current method (O)'	openSingleMessageBrowser		'open a single-message browser on the current version of this method')		
		-
		('toggle diffing (D)'			toggleDiffing					'toggle whether or not diffs should be shown here')
		('update list'				reformulateList					'reformulate the list of versions, in case it somehow got out of synch with reality')
		-
		('help...'					offerVersionsHelp				'provide an explanation of the use of this tool'))
! !

SystemWindow removeSelector: #labelRect!
SystemWindow removeSelector: #labelRect2!
!classDefinition: #SystemWindow category: #'Morphic-OldWindows'!
MorphWithModel subclass: #SystemWindow
	instanceVariableNames: 'labelString paneMorphs collapsedFrame fullFrame isCollapsed updatablePanes paneColor'
	classVariableNames: 'CloseBoxImage CollapseBoxImage TopWindow'
	poolDictionaries: ''
	category: 'Morphic-OldWindows'!
MenuMorph removeSelector: #addStayUpItem!
MenuMorph removeSelector: #addStayUpItemSpecial!
MenuMorph removeSelector: #removeStayUpItems!
MenuMorph removeSelector: #toggleStayUp:!
MenuMorph removeSelector: #toggleStayUpIgnore:evt:!
MenuItemMorph removeSelector: #isStayUpItem!
ImageMorph removeSelector: #borderStyle:!
!classDefinition: #BrowserCommentTextMorph category: #'Tools-Browser'!
PluggableTextMorph subclass: #BrowserCommentTextMorph
	instanceVariableNames: 'browserWindow browserLowerPane'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-Browser'!
!classDefinition: #BorderedMorph category: #'Morphic-OldKernel'!
Morph subclass: #BorderedMorph
	instanceVariableNames: 'borderWidth borderColor borderStyle'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-OldKernel'!
Morph removeSelector: #borderColor!
Morph removeSelector: #borderColor:!
Morph removeSelector: #borderStyle!
Morph removeSelector: #borderStyle:!
Morph removeSelector: #borderStyleForSymbol:!
Morph removeSelector: #borderWidth:!
Morph removeSelector: #setBorderStyle:!
CustomMenu removeSelector: #addStayUpItem!
