'From etoys3.0 of 24 February 2008 [latest update: #1997] on 11 May 2008 at 3:23:05 pm'!
"Change Set:		trnMisc11May08-KR
Date:			11 May 2008
Author:			Korakurider

fix for many of missing translations in 
'Missing Translations Etoys 1996.txt' attached at  TRAC1966"!


!AutoStart class methodsFor: 'updating' stamp: 'KR 5/10/2008 13:45'!
processUpdates
	"Process update files from a well-known update server.  This method is called at system startup time,   Only if the preference #updateFromServerAtStartup is true is the actual update processing undertaken automatically"

	(Preferences valueOfFlag: #updateFromServerAtStartup)
		ifTrue: [
			| choice |
			choice _ (PopUpMenu labels: 'Yes, Update\No, Not now\Don''t ask again' translated withCRs)
				startUpWithCaption: 'Do you want to check for updates\or maintenance fixes on the server?' translated withCRs.
			choice = 1 ifTrue: [Utilities updateFromServer].
			choice = 3 ifTrue: [
				Preferences setPreference: #updateFromServerAtStartup toValue: false.
				self inform: 'Remember to save you image to make this setting permant.' translated].
		].
	^false! !


!BooleanPreferenceView methodsFor: 'user interface' stamp: 'KR 5/10/2008 15:35'!
representativeButtonWithColor: aColor inPanel: aPreferencesPanel
	"Return a button that controls the setting of prefSymbol.  It will keep up to date even if the preference value is changed in a different place"

	| outerButton aButton str miniWrapper |
	
	outerButton := AlignmentMorph newRow height: 24.
	outerButton color:  (aColor ifNil: [Color r: 0.645 g: 1.0 b: 1.0]).
	outerButton hResizing: (aPreferencesPanel ifNil: [#shrinkWrap] ifNotNil: [#spaceFill]).
	outerButton vResizing: #shrinkWrap.
	outerButton addMorph: (aButton := UpdatingThreePhaseButtonMorph checkBox).
	aButton
		target: self preference;
		actionSelector: #togglePreferenceValue;
		getSelector: #preferenceValue.

	outerButton addTransparentSpacerOfSize: (2 @ 0).
	str := StringMorph contents: self preference name font: (StrikeFont familyName: 'NewYork' size: 12).

	self preference localToProject ifTrue:
		[str emphasis: 1].

	miniWrapper := AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap.
	miniWrapper beTransparent addMorphBack: str lock.
	aPreferencesPanel
		ifNotNil:  "We're in a Preferences panel"
			[miniWrapper on: #mouseDown send: #offerPreferenceNameMenu:with:in: to: self withValue: aPreferencesPanel.
			miniWrapper on: #mouseEnter send: #menuButtonMouseEnter: to: miniWrapper.
			miniWrapper on: #mouseLeave send: #menuButtonMouseLeave: to: miniWrapper.
			miniWrapper setBalloonText: 'Click here for a menu of options regarding this preference.  Click on the checkbox to the left to toggle the setting of this preference' translated]

		ifNil:  "We're a naked button, not in a panel"
			[miniWrapper setBalloonText: self preference helpString translated; setProperty: #balloonTarget toValue: aButton].

	outerButton addMorphBack: miniWrapper.
	outerButton setNameTo: self preference name.

	aButton setBalloonText: self preference helpString.

	^ outerButton

	"(Preferences preferenceAt: #balloonHelpEnabled) view tearOffButton"! !


!FileDirectory methodsFor: 'file operations' stamp: 'KR 5/10/2008 13:49'!
rename: oldFileName toBe: newFileName
	| selection oldName newName |
	"Rename the file of the given name to the new name. Fail if there is no file of the old name or if there is an existing file with the new name."
	"Modified for retry after GC ar 3/21/98 18:09"
	oldName _ self fullNameFor: oldFileName.
	newName _ self fullNameFor: newFileName.
	(StandardFileStream 
		retryWithGC:[self primRename: oldName asVmPathName to: newName asVmPathName]
		until:[:result| result notNil]
		forFileNamed: oldName) ~~ nil ifTrue:[^self].
	(self fileExists: oldFileName) ifFalse:[
		^self error:'Attempt to rename a non-existent file' translated.
	].
	(self fileExists: newFileName) ifTrue:[
		selection _ (PopUpMenu labels:
'delete old version
cancel' translated)
				startUpWithCaption: ('Trying to rename a file to be
{1}
and it already exists.' translated format: {newFileName}).
		selection = 1 ifTrue:
			[self deleteFileNamed: newFileName.
			^ self rename: oldFileName toBe: newFileName]].
	^self error:'Failed to rename file' translated.! !


!Flaps class methodsFor: '*connectorsShapes-flaps' stamp: 'KR 5/11/2008 02:49'!
quadsDefiningConnectorsFlap
	"Answer a structure defining the items on the default Connectors flap"

	^ #(
	(NCLabelMorph newStandAlone 'Label' 'A label')
	(NCSmartLabelMorph newStandAlone 'Smart Label' 'A label that positions itself')
	(NCAAConnectorMorph	newStandAlone		'Connector'	'A basic connector')
	(NCAAConnectorMorph	newWithArrow 'ConnectorArrow'	'A basic connector with an arrowhead')
	(NCAAConnectorMorph	newCurvyConnector 'Curvy Connector'	'A basic curved connector')
	(NCAAConnectorMorph	newCurvyArrow 'Curvy ConnectorArrow'	'A basic curved connector with an arrowhead')
	(NCGrabbableDisplayTextMorph authoringPrototype 'Title' 'Display text that you can move')
	(NCTextRectangleMorph new 'Text Rectangle' 'A rectangle with text, or a button')
	(NCButtonBar newStandAlone 'ButtonBar' 'A buttonBar for customizing')
	(NCMakerButton newStandAlone 'Maker Button' 'A handy Morph-generating button')
	(NCBasicShapeMorph newStandAlone 'Basic Shape' 'A simple shape with a context menu')
	(Flaps newNCPartsBinFlap 'New Button Flap' 'A new button flap')
	(NCAttachmentPointAdjusterWindow newStandAlone 'AP Adjuster' 'This lets you adjust the attachment points on a dropped Morph')
	) translatedNoop
! !

!Flaps class methodsFor: '*connectorsShapes-flaps' stamp: 'KR 5/11/2008 02:50'!
quadsDefiningFSMConnectorsFlap
	"Answer a structure defining the items on the default FSM flap"
	"Flaps newFSMConnectorsFlap openInWorld; setToPopOutOnDragOver: false."

	^ #(
	(NCLabelMorph newStandAlone 'Label' 'A label')
	(NCSmartLabelMorph newStandAlone 'Smart Label' 'A label that positions itself')
	(NCAAConnectorMorph newStateTransition 'State Transition' 'A state transition for UML State Diagrams')
	(NCTextRectangleMorph newStateSymbol 'State' 'A UML State shape')
	(NCCompositeStateMorph newCompositeState 'Composite State' 'A UML composite state shape')
	(NCScrolledCompositeStateMorph newStandAlone 'Scrolled State' 'A UML State shape with scrollbars')
	(NCEllipseMorph newStartState 'Start State' 'A UML start state shape')
	(NCEllipseMorph newEndState 'End State' 'A UML end state shape')
	"(NCButtonBar newFSMToolbar 'FSM ButtonBar' 'A buttonBar for State Machine drawings')"
	) translatedNoop! !


!HTTPSocket class methodsFor: 'get the page' stamp: 'KR 5/10/2008 15:31'!
httpShowPage: url
	"Display the exact contents of the given URL as text. See examples in httpGet:"

	| doc |
	doc _ (self httpGet: url accept: 'application/octet-stream') contents.
	doc size = 0 ifTrue: [^ self error: 'Document could not be fetched' translated].
	(StringHolder new contents: doc) openLabel: url.
! !

!HTTPSocket class methodsFor: 'utilities' stamp: 'KR 5/10/2008 13:49'!
retry: tryBlock asking: troubleString ifGiveUp: abortActionBlock
	"Execute the given block. If it evaluates to true, return true. If it evaluates to false, prompt the user with the given string to see if he wants to try again. If not, evaluate the abortActionBlock and return false."

	| response  |
	[tryBlock value] whileFalse: [
		| sema |
		sema _ Semaphore new.
		WorldState addDeferredUIMessage: [
			response _ (PopUpMenu labels: 'Retry\Give Up' translated withCRs)
				startUpWithCaption: troubleString.
			sema signal.
		].
		sema wait.
		response = 2 ifTrue: [abortActionBlock value. ^ false]].
	^ true
! !


!Morph methodsFor: '*connectors-embeddings' stamp: 'KR 5/10/2008 14:51'!
embedInto: evt
	"Embed the receiver into some other morph"
	|  menu target |
	menu _ CustomMenu new.
	self potentialEmbeddingTargets  do: [:m | 
		menu add: (m knownName ifNil:[m class name asString]) action: m].
	target _ menu startUpWithCaption: ('Embed {1} into...' translated format: {self externalName}).
	target ifNil:[^self].
	target addMorphFrontFromWorldPosition: self.! !


!ArchiveViewer methodsFor: 'archive operations' stamp: 'KR 5/10/2008 14:56'!
openNewArchive
	| menu result |
	menu _ StandardFileMenu oldFileMenu: (FileDirectory default) withPattern: '*.zip'.
	result := menu startUpWithCaption: 'Select Zip archive to open...' translated.
	result ifNil: [ ^self ].
	self fileName: (result directory fullNameFor: result name).
! !

!ArchiveViewer methodsFor: 'archive operations' stamp: 'KR 5/10/2008 14:56'!
writePrependingFile
	| result name prependedName |
	self canSaveArchive ifFalse: [ ^self ].
	result _ (StandardFileMenu newFileMenu: FileDirectory default)
		startUpWithCaption: 'Destination Zip File Name:' translated.
	result ifNil: [ ^self ].
	name _ result directory fullNameFor: result name.
	(archive canWriteToFileNamed: name)
		ifFalse: [ self inform: name, ' is used by one or more members
in your archive, and cannot be overwritten.
Try writing to another file name' translated.
			^self ].
	result _ (StandardFileMenu oldFileMenu: FileDirectory default)
		startUpWithCaption: 'Prepended File:' translated.
	result ifNil: [ ^self ].
	prependedName _ result directory fullNameFor: result name.
	[ archive writeToFileNamed: name prependingFileNamed: prependedName ]
		on: Error
		do: [ :ex | self inform: ex description. ].
	self changed: #memberList	"in case CRC's and compressed sizes got set"! !


!EToyChatMorph methodsFor: 'as yet unclassified' stamp: 'KR 5/10/2008 15:08'!
rebuild
	| r1 r2 |

	r1 _ self addARow: {
		self simpleToggleButtonFor: self attribute: #acceptOnCR help: 'Send with Return?' translated.
		self inAColumn: {StringMorph new contents: 'Your message to:' translated; font: Preferences standardMenuFont; lock}.
		self textEntryFieldNamed: #ipAddress with: ''
					help: 'IP address for chat partner' translated.
	}.
	recipientForm ifNotNil: [
		r1 addMorphBack: recipientForm asMorph lock
	].
	sendingPane _ PluggableTextMorph
				on: self
				text: nil
				accept: #acceptTo:forMorph:.
	sendingPane hResizing: #spaceFill; vResizing: #spaceFill.
	sendingPane font: Preferences standardMenuFont.
	self
		addMorphBack: sendingPane.
	r2 _ self addARow: {self inAColumn: {StringMorph new contents: 'Replies' translated; font: Preferences standardMenuFont; lock}}.
	receivingPane _ PluggableTextMorph
				on: self
				text: nil
				accept: nil.
	receivingPane font: Preferences standardMenuFont.
	receivingPane hResizing: #spaceFill; vResizing: #spaceFill.
	self
		addMorphBack: receivingPane.
	receivingPane spaceFillWeight: 3.
	{r1. r2} do: [ :each |
		each
			vResizing: #shrinkWrap; minHeight: 18;
			color: Color veryLightGray.
	].
	sendingPane acceptOnCR: (acceptOnCR ifNil: [acceptOnCR _ true])! !


!EToyCommunicatorMorph class methodsFor: 'as yet unclassified' stamp: 'KR 5/10/2008 13:47'!
instanceReport	"for cleaning up Alan's demo"
"
EToySenderMorph instanceReport
"
	| answer resp |

	Smalltalk garbageCollect.
	answer _ self allInstances collect: [ :each |
		{
			each.
			[each ipAddress] on: Error do: [ 'no ipAddress'].
			each owner 
					ifNil: ['* no owner *'] 
					ifNotNil: [each owner innocuousName,' ',each owner printString].
			each world ifNil: ['-----no project-----'] ifNotNil: [each world project name].
		}
	].
	resp _ (PopUpMenu labels: 'IP Address\Project\Owner' translated withCRs) startUpWithCaption: 
					'Sorted by' translated.
	resp = 1 ifTrue: [
		^(answer asSortedCollection: [ :a :b | a second <= b second]) asArray explore
	].
	resp = 2 ifTrue: [
		^(answer asSortedCollection: [ :a :b | a fourth <= b fourth]) asArray explore
	].
	resp = 3 ifTrue: [
		^(answer asSortedCollection: [ :a :b | a third <= b third]) asArray explore
	].
	answer explore! !


!EventRecordingSpace methodsFor: 'menu' stamp: 'KR 5/10/2008 15:10'!
addMenuButtonItemsTo: aMenu
	"Build the contents of the menu to be presented when the menu button in my tool-bar is clicked."

	"CAUTION:  Debugging items still present."

	aMenu addTitle: 'Recording Options' translated.

	aMenu addTranslatedList: #(
		('set balloon help'		setBalloonHelp  'Allows you to provide a message to be presented to a user as balloon-help when the mouse lingers over buttons that trigger playback of the tape of this event theatre')
		('shrink event tape' shrinkTape)
		"('save on file...' saveSequenceOnFile)"
		-
		('revert to version...'	offerVersions)
		('delete old versions'	deleteOldVersions)
		-) translatedNoop.

	Preferences sugarNavigator
		ifTrue:
			[aMenu addTranslatedList: (self sugarNavigatorFlapOrNil
				ifNil: [#(('add sugar navigator flap' addSugarNavigatorFlap)) translatedNoop]
				ifNotNil: [#(('remove sugar navigatorFlap' removeSugarNavigatorFlap)) translatedNoop])]
		ifFalse:
			[aMenu addTranslatedList: (self navigatorFlapOrNil
				ifNil: [#(('add navigator flap' addNavigatorFlap)) translatedNoop]
				ifNotNil: [#(('remove navigatorFlap' removeNavigatorFlap)) translatedNoop]).

			aMenu addTranslatedList: (self suppliesFlapOrNil
				ifNil: [#(('add supplies flap' addSuppliesFlap)) translatedNoop]
				ifNotNil: [#(('remove suppliesFlap' removeSuppliesFlap)) translatedNoop])].

	aMenu addTranslatedList: #(
		-
		('event roll' makeHorizontalRoll 'open a horizontal piano-roll-like tool for the viewing and editing the events of this event theatre.')
		('remove event-roll' removeEventRoll  'abandon any event-roll that may be associated with this theatre.')
		-) translatedNoop.

	Preferences debugging ifTrue:
		[self addMoreSubMenuTo: aMenu]! !


!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'KR 5/10/2008 13:43'!
moreCommands
	"Put up a menu of options"

	| allThreads aMenu others target |
	allThreads _ self class knownThreads.
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addTitle: 'navigation' translated.
	aMenu addStayUpItem.
	self flag: #deferred.  "Probably don't want that stay-up item, not least because the navigation-keystroke stuff is not dynamically handled"
	others _ (allThreads keys reject: [ :each | each = threadName]) asSortedCollection.
	others do: [ :each |
		aMenu add: ('switch to <{1}>' translated format:{each}) selector: #switchToThread: argument: each].
	aMenu addList: {
		{'switch to recent projects' translated.  #getRecentThread}.
		#-.
		{'create a new thread' translated.  #threadOfNoProjects}.
		{'edit this thread' translated.  #editThisThread}.
		{'create thread of all projects' translated.  #threadOfAllProjects}.
		#-.
		{'First project in thread' translated.  #firstPage}.
		{'Last project in thread' translated.  #lastPage}}.
	(target _ self currentIndex + 2) > listOfPages size ifFalse:
		[aMenu 
			add: ('skip over next project ({1})' translated format:{(listOfPages at: target - 1) first})
			action: #skipOverNext].
	aMenu addList: {
		{'jump within this thread' translated.  #jumpWithinThread}.
		{'insert new project' translated.  #insertNewProject}.
		#-.
		{'simply close this navigator' translated.  #delete}.
		{'destroy this thread' translated. #destroyThread}.
		#-}.

	(ActiveWorld hasProperty: #threadNavigatorPosition) ifTrue: [
		aMenu addList: {
			{'reset preferred location' translated. #resetBottomRightPosition}.
			#-}.
	] ifFalse: [		
		aMenu addList: {
			{'remember preferred location in this project' translated. #setBottomRightPosition}.
			#-}.
	].

	(ActiveWorld keyboardNavigationHandler == self)
		ifFalse:
			[aMenu add: 'start keyboard navigation with this thread' translated action: #startKeyboardNavigation]
		ifTrue:
			[aMenu add: 'stop keyboard navigation with this thread' translated action: #stopKeyboardNavigation].

	aMenu popUpInWorld! !


!LanguageEditor methodsFor: 'gui methods' stamp: 'KR 5/10/2008 15:31'!
codeSelectedTranslation
	| keys code |
	keys := selectedTranslations
				collect: [:key | self translations at: key].
	code := String
				streamContents: [:aStream | self translator fileOutOn: aStream keys: keys withBOM: false].
	(StringHolder new contents: code)
		openLabel: 'exported codes' translated! !

!LanguageEditor methodsFor: 'gui methods' stamp: 'KR 5/10/2008 15:31'!
codeSelectedTranslationAsMimeString
	| keys code tmpStream s2 gzs cont |
	keys := selectedTranslations
				collect: [:key | self translations at: key].
	code := String
				streamContents: [:aStream | self translator fileOutOn: aStream keys: keys withBOM: false].

	tmpStream _ MultiByteBinaryOrTextStream on: ''.
	tmpStream converter: UTF8TextConverter new.
	tmpStream nextPutAll: code.
	s2 _ RWBinaryOrTextStream on: ''.
	gzs := GZipWriteStream on: s2.
	tmpStream reset.
	gzs nextPutAll: (tmpStream binary contentsOfEntireFile asString) contents.
	gzs close.
	s2 reset.

	cont _ String streamContents: [:strm |
		strm nextPutAll: '"Gzip+Base64 encoded translation for;'; cr.
		strm nextPutAll: '#('.
		keys do: [:each | strm  nextPutAll: '''', each, ''' '.].
		strm nextPutAll: ')"'; cr; cr.
		strm nextPutAll: 'NaturalLanguageTranslator loadForLocaleIsoString: '.
		strm nextPut: $'.
		strm nextPutAll: translator localeID isoString.
		strm nextPut: $'.
		strm nextPutAll: ' fromGzippedMimeLiteral: '.
		strm nextPut: $'.
		strm nextPutAll: (Base64MimeConverter mimeEncode: s2) contents.
		strm nextPutAll: '''.'.
		strm cr.
	].
	
	(StringHolder new contents: cont)
		openLabel: 'exported codes in Gzip+Base64 encoding' translated! !

!LanguageEditor methodsFor: 'gui methods' stamp: 'KR 5/10/2008 15:11'!
getTextImport
	| menu |
	menu := MenuMorph new defaultTarget: self.
	menu addTitle: 'Choose translation file' translated.
	menu add: 'All *.po files' translated action: #getTextImportAll.
	menu add: 'Choose a file' translated action: #getTextImportAFile.
	menu popUpInWorld! !


!MoviePlayerMorph methodsFor: 'menu' stamp: 'KR 5/10/2008 15:47'!
openMovieFile
	| fileName |
	fileName _ Utilities chooseFileWithSuffixFromList: #('.movie')
					withCaption: 'Choose a movie file to open' translated.
	fileName ifNotNil:
		[self openFileNamed: fileName.
		self showMoreControls]! !


!NCConstraintMorph methodsFor: 'menus' stamp: 'KR 5/10/2008 15:02'!
addCustomMenuItems: aCustomMenu hand: aHandMorph 
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	aCustomMenu
		addLine;
		add: 'attach to...' translated action: #attachToSelectedMorph:;
		add: 'display attachments' translated action: #displayInputs;
		addLine.

	false
		ifTrue: [aCustomMenu
				add: 'add arbitrary shape...' translated
				target: self
				selector: #addSelectedMorph:.
			self class preMadeShapeNames isEmpty
				ifFalse: [aCustomMenu add: 'add pre-made shape...' translated subMenu: self selectShapeMenu].
			aCustomMenu
				add: 'delete shape...' translated
				target: self
				selector: #deleteSelectedMorph:;
				 addLine].

	"connectToAbsolutePoint:"

	#('connect to center'
		'connect to nearest attachment point'
		'connect to nearest point'
		'connect to nearest point to center'
		'connect to relative point...'
		'no connection preference' ) translatedNoop.

	#(#connectToCenter
		#connectToNearestAttachmentPoint
		#connectToNearestPoint
		#connectToNearestPointToCenter
		#connectToRelativePoint:
		#noConnectionPreference )
		do: [:sel | aCustomMenu
				addUpdating: #connectionWordingFor:
				target: self
				selector: #choosePreferredConnection:
				argumentList: {sel}].
	self dieWithInput
		ifFalse: [aCustomMenu
				addUpdating: #connectionWordingFor:
				target: self
				selector: #choosePreferredConnection:
				argumentList: #(#connectToNothing )]! !

!NCConstraintMorph methodsFor: 'menus' stamp: 'KR 5/10/2008 14:50'!
attachToSelectedMorph: anEvent
	"Allow the user to select a new input"
	| handle targets highlights |
	highlights _ self highlightInputs.
	handle _ NewHandleMorph new 
		followHand: anEvent hand
		forEachPointDo: [ :newPoint |  ]
		lastPointDo: [ :newPoint | | localPoint choice |
			localPoint _ self globalPointToLocal: newPoint.
			highlights do: [ :ea | ea  delete ].
			targets _ self connectionTargetsAt: localPoint.
			targets _ targets copyWithout: handle.
			targets isEmpty
				ifTrue: [ self connectToAbsolutePoint: localPoint ]
				ifFalse: [ choice _ targets size = 1
					ifTrue: [ 1 ]
					ifFalse: [ (PopUpMenu labelArray: (targets collect: [ :ea | ea name ]))
							startUpWithCaption: 'Select Morph' translated].
					choice > 0
						ifTrue: [ self attachUnobnoxiouslyTo: (targets at: choice) at: localPoint ]
				].
		].
	anEvent hand attachMorph: handle.
	handle startStepping.! !

!NCConstraintMorph methodsFor: 'menus' stamp: 'KR 5/10/2008 14:45'!
deleteSelectedMorph: anEvent
	"Allow the user to delete one of my submorphs, if any."
	| choice |
	submorphs isEmpty ifTrue: [ ^self ].
	submorphs size = 1 ifTrue: [ ^self deleteShape: submorphs first ].

	choice _ (PopUpMenu labelArray: (submorphs collect: [ :ea | ea externalName ]))
							startUpWithCaption: 'Select Morph' translated.
	choice > 0 ifTrue: [ self deleteShape: (submorphs at: choice) ].! !


!NCGlyphEditor methodsFor: 'button actions' stamp: 'KR 5/10/2008 15:42'!
writeConstructor

	| string name sample |
	sample _ self sampleGlyph.
	sample ifNil: [ ^self ].
	name _ FillInTheBlankMorph request: 'Install in which selector?' translated.

	string _ String streamContents: [ :stream |
		stream nextPutAll: name; cr; tab.
		stream nextPutAll: '"glyph '; print: glyph glyphIndex; nextPutAll: ' from '; nextPutAll: font name; nextPut: $"; cr.
		stream nextPutAll: '	^'.
		sample storeOn: stream.
		self clickPoints isEmpty ifFalse: [ stream nextPutAll: '"clicks: '.
			transformedClickPoints do: [ :p | stream store: (p roundTo: 0.01); space.  ].
			stream nextPut: $"
		]
	].

	name isEmpty ifTrue: [
	Clipboard clipboardText: string.
	^self inform: 'Constructor text is on clipboard.' translated ].

	NCLineArrowGlyph class compile: string classified: 'arrow forms' ! !


!PasteUpMorph methodsFor: 'menu & halo' stamp: 'KR 5/10/2008 15:12'!
presentCardAndStackMenu
	"Put up a menu holding card/stack-related options."

	| aMenu |
	aMenu _ MenuMorph new defaultTarget: self.		
	aMenu addStayUpItem.
	aMenu addTitle: 'card und stack' translated.
	aMenu add: 'add new card' translated action: #insertCard.
	aMenu add: 'delete this card' translated action: #deleteCard.
	aMenu add: 'go to next card' translated action: #goToNextCardInStack.
	aMenu add: 'go to previous card' translated action: #goToPreviousCardInStack.
	aMenu addLine.
	aMenu add: 'show foreground objects' translated action: #showForegroundObjects.
	aMenu add: 'show background objects' translated action: #showBackgroundObjects.
	aMenu add: 'show designations' translated action: #showDesignationsOfObjects.
	aMenu add: 'explain designations'  translated action: #explainDesignations.
	aMenu popUpInWorld: (self world ifNil: [self currentWorld])! !

!PasteUpMorph methodsFor: 'world state' stamp: 'KR 5/10/2008 14:08'!
checkCurrentHandForObjectToPaste

	| response |
	self primaryHand pasteBuffer ifNil: [^self].
	response _ (PopUpMenu labels: 'Delete\Keep' translated withCRs)
		startUpWithCaption: 'Hand is holding a Morph in its paste buffer:\' translated withCRs,
			self primaryHand pasteBuffer printString.
	response = 1 ifTrue: [self primaryHand pasteBuffer: nil].
! !

!PasteUpMorph methodsFor: '*flexiblevocabularies-scripting' stamp: 'KR 5/10/2008 15:30'!
printVocabularySummary
	"Put up a window with summaries of all Morph vocabularies."

	
	(StringHolder new contents: EToyVocabulary vocabularySummary) 
	openLabel: 'EToy Vocabulary' translated

	"self currentWorld printVocabularySummary"! !


!Player methodsFor: 'costume' stamp: 'KR 5/10/2008 14:44'!
changeParameterTypeFor: aSelector
	"Change the parameter type for the given selector.  Not currently sent, since types are now set by direct manipulation in the Scriptor header.  If this were reinstated someday, there would probably be an issue about getting correct-looking Parameter tile(s) into the Scriptor header(s)"

	| current typeChoices typeChosen |
	current _ self typeforParameterFor: aSelector.
	typeChoices _ Vocabulary typeChoices.
	typeChosen _ (SelectionMenu selections: typeChoices lines: #()) startUpWithCaption: 
		('Choose the TYPE
for the parameter (currently {1})' translated format: {current}).
	self setParameterFor: aSelector toType: typeChosen

! !

!Player methodsFor: 'costume' stamp: 'KR 5/10/2008 14:42'!
newCostume

	| aMenu reply |
	aMenu _ SelectionMenu selections: self availableCostumeNames.
	(reply _ aMenu startUpWithCaption: 'choose a costume' translated) ifNil: [^ self].
	self wearCostumeOfName: reply.
	self updateAllViewers! !

!Player methodsFor: 'slots-user' stamp: 'KR 5/10/2008 14:44'!
chooseSlotTypeFor: aGetter
	"Let the user designate a type for the slot associated with the given getter"

	| typeChoices typeChosen slotName |
	slotName _ Utilities inherentSelectorForGetter: aGetter.
	typeChoices _ Vocabulary typeChoices.
	typeChosen _ (SelectionMenu labelList: (typeChoices collect: [:t | t translated]) lines: #() selections: typeChoices) startUpWithCaption: 
		('Choose the TYPE
for {1}
' translated, slotName, '
(currently {2})' translated format: {slotName. (self slotInfoAt: slotName) type translated}).
	typeChosen isEmptyOrNil ifTrue: [^ self].
	(self typeForSlot: slotName) capitalized = typeChosen ifTrue: [^ self].

	(self slotInfoAt: slotName) type: typeChosen.
	self class allInstancesDo:   "allSubInstancesDo:"
		[:anInst | anInst instVarNamed: slotName asString put: 
			(anInst valueOfType: typeChosen from: (anInst instVarNamed: slotName))].
	self updateAllViewers.	"does siblings too"
	self changeTypesInWatchersOf: slotName  "does siblings too"
! !

!Player methodsFor: 'slots-user' stamp: 'KR 5/10/2008 14:42'!
chooseUserSlot
	| names aMenu result |
	(names _ self slotNames) size == 1
		ifTrue: [^ names first].
	aMenu _ SelectionMenu selections: names.
	result _ aMenu startUpWithCaption: 'Please choose a variable' translated.
	result isEmptyOrNil ifTrue: [^ nil].
	^ result! !


!KedamaExamplerPlayer methodsFor: 'player protocol' stamp: 'KR 5/10/2008 14:53'!
chooseSlotTypeFor: aGetter
	"Let the user designate a type for the slot associated with the given getter"

	| typeChoices typeChosen slotName |
	slotName _ Utilities inherentSelectorForGetter: aGetter.
	typeChoices _ Vocabulary typeChoices.

	typeChosen _ (SelectionMenu labelList: (typeChoices collect: [:t | t translated]) lines: #() selections: typeChoices) startUpWithCaption: 
		('Choose the TYPE
for {1}
(currently {2})' format: {slotName. (self slotInfoAt: slotName) type translated}).
	typeChosen isEmptyOrNil ifTrue: [^ self].
	(self typeForSlot: slotName) capitalized = typeChosen ifTrue: [^ self].

	(self slotInfoAt: slotName) type: typeChosen.
	self class allInstancesDo:   "allSubInstancesDo:"
		[:anInst | anInst instVarNamed: slotName asString put: 
			(anInst valueOfType: typeChosen from: (anInst instVarNamed: slotName))].
	turtles setVectorSlotTypeFor: slotName typeChosen: typeChosen.
	sequentialStub ifNotNil: [sequentialStub setScalarSlotTypeFor: slotName typeChosen: typeChosen].
	self updateAllViewers.	"does siblings too"
! !


!PluggableFileList class methodsFor: 'validateBlocks' stamp: 'KR 5/10/2008 14:07'!
okToOpen: aFileNameString without: aSuffixString

	"Answer whether user confirms that it is ok to overwrite the file named in aString"
	^ 1 = ((PopUpMenu
		labels:
'overwrite that file
select another file' translated)
		startUpWithCaption: ('{1}
already exists.' translated format: {aFileNameString}))
! !

!PluggableFileList class methodsFor: 'validateBlocks' stamp: 'KR 5/10/2008 14:07'!
okToOverwrite: aString

	"Answer whether user confirms that it is ok to overwrite the file named in aString"
	^ 1 = ((PopUpMenu
		labels:
'overwrite that file
select another file' translated)
		startUpWithCaption: ('{1}
already exists.' translated format: {aString}))
! !


!Preference methodsFor: 'menu' stamp: 'KR 5/11/2008 14:48'!
helpString
	"Answer the help string provided for the receiver"

	^ helpString ifNil: ['no help available' translatedNoop]! !

!Preference methodsFor: 'local to project' stamp: 'KR 5/10/2008 15:36'!
isProjectLocalString
	"Answer a string representing whether sym is a project-local preference or not"

	| aStr |
	aStr _  'each project has its own setting' translated.
	^ localToProject
		ifTrue:
			['<yes>', aStr]
		ifFalse:
			['<no>', aStr]! !


!Preferences class methodsFor: 'window colors' stamp: 'KR 5/10/2008 15:28'!
windowColorHelp
	"Provide help for the window-color panel"

	| helpString |
	helpString _ 
'The "Window Colors" panel lets you select colors for many kinds of standard Squeak windows.

You can change your color preference for any particular tool by clicking on the color swatch and then selecting the desired color from the resulting color-picker.

The three buttons entitled "Bright", "Pastel", and "White" let you revert to any of three different standard color schemes.  

The choices you make in the Window Colors panel only affect the colors of new windows that you open.

You can make other tools have their colors governed by this panel by simply implementing #windowColorSpecification on the class side of the model -- consult implementors of that method to see examples of how to do this.'.

	 (StringHolder new contents: helpString)
		openLabel: 'About Window Colors' translated

	"Preferences windowColorHelp"! !


!Project methodsFor: 'file in/out' stamp: 'KR 5/10/2008 14:06'!
decideAboutCreatingBlank: otherProjectName

	| resp |

	"20 Oct - just do it"
	true "version isNil" ifFalse: [	"if saved, then maybe don't create"
		resp _ (PopUpMenu labels: 'Yes, make it up\No, skip it' translated withCRs) 
			startUpWithCaption: (
				'I cannot locate the project\' translated ,
				otherProjectName,
				'\Would you like me to create a new project\with that name?' translated
			) withCRs.
		resp = 1 ifFalse: [^ nil]
	].
	^Project openBlankProjectNamed: otherProjectName! !


!QHsmMorph methodsFor: 'debug and other' stamp: 'KR 5/10/2008 15:43'!
buildDebugMenu: aHand
	| menu |
	menu _ super buildDebugMenu: aHand.
	menu addLine.
	menu add: 'browse state handler class' translated target: self eventHandler selector: #browseHierarchy.
	menu add: 'view state hierarchy' translated target: self selector: #viewStateHierarchy.
	menu add: 'view log' translated target: self selector: #viewLog.
	menu add: 'clear log' translated target: self selector: #clearLog.
	menu addLine.
	menu add: 'start logging all but move and step events' translated target: self selector: #startLoggingAll.
	menu add: 'start logging move events' translated target: self selector: #startLoggingMoveEvents.
	menu add: 'start logging step events' translated target: self selector: #startLoggingStepEvents.
	menu add: 'start logging event...' translated target: self selector: #startLoggingSelectedEvent.
	menu addLine.
	"self loggingTypes isEmpty ifFalse: ["
		menu add: 'stop logging all events' translated target: self selector: #stopLoggingAll.
		menu add: 'stop logging event...' translated target: self selector: #stopLoggingSelectedEvent.
	"]."
	^menu! !


!ScreenController methodsFor: 'menu messages' stamp: 'KR 5/10/2008 14:25'!
setDisplayDepth
	"Let the user choose a new depth for the display. "
	| result |
	(result _ (SelectionMenu selections: Display supportedDisplayDepths) startUpWithCaption: ('Choose a display depth
(it is currently {1})' translated format: {Display depth printString})) == nil ifFalse:
		[Display newDepth: result]! !


!ServerDirectory methodsFor: 'file directory' stamp: 'KR 5/10/2008 15:24'!
newFileNamed: fullName
	"Create a RemoteFileStream.  If the file exists, and complain.  fullName is directory path, and does include name of the server.  Or it can just be a fileName.  Only write the data upon close."

	| file remoteStrm selection |

	file _ self asServerFileNamed: fullName.
	file readWrite.
	file isTypeFile ifTrue: [
		^ FileStream newFileNamed: (file fileNameRelativeTo: self)].
	file exists 
		ifTrue: [
			selection _ (PopUpMenu labels: 'overwrite that file
choose another name
cancel' translated)
				startUpWithCaption: (file fullNameFor: file fileName) , '
already exists.']
		ifFalse: [selection _ 1].

	selection = 1 ifTrue:
		[remoteStrm _ RemoteFileStream on: (String new: 2000).
		remoteStrm remoteFile: file.
		remoteStrm dataIsValid.	"empty stream is the real contents!!"
		^ remoteStrm].	"no actual writing till close"
	selection = 2 ifTrue: [
		^ self newFileNamed:
			(FillInTheBlank request: 'Enter a new file name' translated
				initialAnswer: file fileName)].
	^ nil	"cancel"! !


!SimpleMIDIPort class methodsFor: 'utilities' stamp: 'KR 5/10/2008 15:21'!
inputPortNumFromUser
	"Prompt the user for a MIDI input port. Answer a port number, or nil if the user does not select a port or if MIDI is not supported on this platform."
	"SimpleMIDIPort inputPortNumFromUser"

	| portCount aMenu dir |
	portCount _ self primPortCount.
	portCount = 0 ifTrue: [^ nil].
	aMenu _ CustomMenu new title: 'MIDI port for input:' translated.
	0 to: portCount - 1 do:[:i |
		dir _ self primPortDirectionalityOf: i.
		(dir = 1) | (dir = 3) ifTrue:[
			aMenu add: (self portDescription: i) action: i]].
	 ^ aMenu startUp
! !


!SmartRefStream methodsFor: 'class changed shape' stamp: 'KR 5/10/2008 14:21'!
writeClassRenameMethod: sel was: oldName fromInstVars: oldList
	"The class coming is unknown.  Ask the user for the existing class it maps to.  If got one, write a method, and restart the obj fileIn.  If none, write a dummy method and get the user to complete it later.  "

| tell choice  newName answ code |

	self flag: #bobconv.	


tell _ 'Reading an instance of {1}.
Which modern class should it translate to?' translated format: {oldName}.
answ _ (PopUpMenu labels: 'Let me type the name now
Let me think about it
Let me find a conversion file on the disk' translated ) startUpWithCaption: tell. 

answ = 1 ifTrue: [
	tell := 'Name of the modern class {1} should translate to:' translated format: {oldName}.
	choice _ FillInTheBlank request: tell.		"class name"
	(choice size = 0) 
		ifTrue: [answ _ 'conversion method needed']
		ifFalse: [newName _ choice.
			answ _ Smalltalk at: newName asSymbol 
				ifAbsent: ['conversion method needed'].
			answ isString ifFalse: [renamed at: oldName asSymbol put: answ name]]].
(answ = 3) | (answ = 0) ifTrue: [self close.
		^ 'conversion method needed'].
answ = 2 ifTrue: [answ _ 'conversion method needed'].
answ = 'conversion method needed' ifTrue: [
		self close.  
		newName _ 'PutNewClassHere'].

code _ WriteStream on: (String new: 500).
code nextPutAll: sel; cr.
code cr; tab; nextPutAll: '^ ', newName.	"Return new class"

self class compile: code contents classified: 'conversion'.

newName = 'PutNewClassHere' ifTrue: [
	self inform: 'Please complete the following method and 
then read-in the object file again.'.
	SystemNavigation default browseAllImplementorsOf: sel asSymbol]. 

	"The class version number only needs to change under one specific circumstance.  That is when the first letters of the instance variables have stayed the same, but their meaning has changed.  A conversion method is needed, but this system does not know it.  
	If this is true for class Foo, define classVersion in Foo class.  
	Beware of previous object fileouts already written after the change in meaning, but before bumping the version number.  They have the old (wrong) version number, say 2.  If this is true, your method must be able to test the data and successfully read files that say version 2 but are really 3."

	^ answ! !


!StandardFileMenu methodsFor: 'basic control sequences' stamp: 'KR 5/10/2008 14:00'!
confirmExistingFiles: aResult

	|choice|
	(aResult directory fileExists: aResult name) ifFalse: [^aResult].
	
	choice _ (PopUpMenu
		labels:
'overwrite that file
choose another name
cancel' translated)
		startUpWithCaption: ('{1}
already exists.' translated format: {aResult name}).

	choice = 1 ifTrue: [
		aResult directory 
			deleteFileNamed: aResult name
			ifAbsent: 
				[^self startUpWithCaption: 
('Can''t delete {1}
Select another file' translated format: {aResult name})].
		^aResult].
	choice = 2 ifTrue: [^self startUpWithCaption: 'Select Another File' translated].
	^nil
 ! !

!StandardFileMenu methodsFor: 'basic control sequences' stamp: 'KR 5/10/2008 14:17'!
getTypedFileName: aResult

	| name |
	name _ FillInTheBlank 
		request: 'Enter a new file name' translated
		initialAnswer: ''.
	name = '' ifTrue: [^self startUpWithCaption: 'Select a File:' translated].
	name _ aResult directory fullNameFor: name.
	^ StandardFileMenuResult
			directory: (FileDirectory forFileName: name)
			name: (FileDirectory localNameFor: name)
! !


!StandardFileStream class methodsFor: 'error handling' stamp: 'KR 5/11/2008 15:02'!
fileDoesNotExistUserHandling: fullFileName

	| selection newName |
	selection _ (PopUpMenu labels:
'create a new file
choose another name
cancel' translated)
			startUpWithCaption: ('{1}
does not exist.' translated format: {FileDirectory localNameFor: fullFileName}) .

	selection = 1 ifTrue:
		[^ self new open: fullFileName forWrite: true].
	selection = 2 ifTrue:
		[ newName _ FillInTheBlank request: 'Enter a new file name' translated
						initialAnswer:  fullFileName.
		^ self oldFileNamed:
			(self fullName: newName)].
	^ self error: 'Could not open a file'! !

!StandardFileStream class methodsFor: 'error handling' stamp: 'KR 5/10/2008 13:56'!
fileExistsUserHandling: fullFileName
	| dir localName choice newName newFullFileName |
	dir _ FileDirectory forFileName: fullFileName.
	localName _ FileDirectory localNameFor: fullFileName.
	choice _ (PopUpMenu
		labels:
'overwrite that file\choose another name\cancel' translated withCRs)
		startUpWithCaption: ('{1}
already exists.' translated format: {localName}).

	choice = 1 ifTrue: [
		dir deleteFileNamed: localName
			ifAbsent: [self error: 'Could not delete the old version of that file' translated].
		^ self new open: fullFileName forWrite: true].

	choice = 2 ifTrue: [
		newName _ FillInTheBlank request: 'Enter a new file name' translated initialAnswer: fullFileName.
		newFullFileName _ self fullName: newName.
		^ self newFileNamed: newFullFileName].

	self error: 'Please close this to abort file opening' translated! !

!StandardFileStream class methodsFor: 'error handling' stamp: 'KR 5/10/2008 14:17'!
readOnlyFileDoesNotExistUserHandling: fullFileName

	| dir files choices selection newName fileName |
	dir _ FileDirectory forFileName: fullFileName.
	files _ dir fileNames.
	fileName _ FileDirectory localNameFor: fullFileName.
	choices _ fileName correctAgainst: files.
	choices add: 'Choose another name' translated.
	choices add: 'Cancel' translated.
	selection _ (PopUpMenu labelArray: choices lines: (Array with: 5) )
		startUpWithCaption: ( '{1}
does not exist.' translated format: {FileDirectory localNameFor: fullFileName}).
	selection = choices size ifTrue:["cancel" ^ nil "should we raise another exception here?"].
	selection < (choices size - 1) ifTrue: [
		newName _ (dir pathName , FileDirectory slash , (choices at: selection))].
	selection = (choices size - 1) ifTrue: [
		newName _ FillInTheBlank 
							request: 'Enter a new file name' translated 
							initialAnswer: fileName].
	newName = '' ifFalse: [^ self readOnlyFileNamed: (self fullName: newName)].
	^ self error: 'Could not open a file'! !


!StrikeFont class methodsFor: 'font creation' stamp: 'KR 5/10/2008 14:12'!
hostFontFromUser
	"StrikeFont hostFontFromUser"
	| fontNames index labels |
	fontNames _ self listFontNames asSortedCollection.
	labels _ WriteStream on: (String new: 100).
	fontNames do:[:fn| labels nextPutAll: fn] separatedBy:[labels cr].
	index _ (PopUpMenu labels: labels contents) startUpWithCaption:'Choose your font' translated.
	index = 0 ifTrue:[^nil].
	^fontNames at: index! !


!HostFont class methodsFor: 'accessing' stamp: 'KR 5/10/2008 13:49'!
fontNameFromUser
	"HostFont fontNameFromUser"
	| fontNames index labels |
	fontNames _ self listFontNames asSortedCollection.
	labels _ WriteStream on: (String new: 100).
	fontNames do:[:fn| labels nextPutAll: fn] separatedBy:[labels cr].
	index _ (PopUpMenu labels: labels contents) startUpWithCaption:'Choose your font' translated.
	index = 0 ifTrue:[^nil].
	^fontNames at: index! !


!Text methodsFor: 'attributes' stamp: 'KR 5/10/2008 13:53'!
askIfAddStyle: priorMethod req: requestor
	"Ask the user if we have a complex style (i.e. bold) for the first time"
	| tell answ old |
	(Preferences browseWithPrettyPrint and: [Preferences colorWhenPrettyPrinting])
		ifTrue: [self couldDeriveFromPrettyPrinting ifTrue: [^ self asString]].
	self runs coalesce.
	self unembellished ifTrue: [^ self asString].
	priorMethod ifNotNil: [old _ priorMethod getSourceFromFile].
	(old == nil or: [old unembellished])
		ifTrue:
			[tell _ 'This method contains style for the first time (e.g. bold or colored text).
Do you really want to save the style info?' translated.
			answ _ (PopUpMenu labels: 'Save method with style
Save method simply' translated)
						startUpWithCaption: tell.
			answ = 2 ifTrue: [^ self asString]]! !


!TextMessageLink methodsFor: 'acting' stamp: 'KR 5/10/2008 13:52'!
actOnClickFor: evt 
	| choice viewMsg |
	viewMsg _ message containsViewableImage
		ifTrue: ['view this image attachment' translated]
		ifFalse: ['view this attachment' translated ].
	choice _ (PopUpMenu labels: viewMsg, '\save this attachment' translated withCRs) startUp.
	choice = 1
		ifTrue: ["open a new viewer"
			message viewBody].
	choice = 2
		ifTrue: ["save the mesasge"
			message save].
	^ true! !


!TextPlusMorph methodsFor: 'as yet unclassified' stamp: 'KR 5/10/2008 15:20'!
doYellowButtonPress: evt

	| menu |

	menu _ CustomMenu new.
	menu 
		add: 'Go to top of document' translated				action: [self jumpToDocumentTop];
		add: 'Move selection to top of page' translated		action: [self scrollSelectionToTop];
		add: 'Add column break' translated					action: [self addColumnBreak];
		add: 'Define as jump start' translated				action: [self addJumpBeginning];
		add: 'Define as jump end' translated				action: [self addJumpEnd].

	((menu build startUpCenteredWithCaption: 'Text navigation options') ifNil: [^self]) value.
! !


!TheWorldMenu methodsFor: 'commands' stamp: 'KR 5/10/2008 15:29'!
vmStatistics
	"Open a string view on a report of vm statistics"

	(StringHolder new contents: SmalltalkImage current  vmStatisticsReportString)
		openLabel: 'VM Statistics' translated! !


!Utilities class methodsFor: 'summer97 additions' stamp: 'KR 5/10/2008 14:14'!
chooseFileWithSuffix: aSuffix
	"Utilities chooseFileWithSuffix: '.gif'"
	| aList aName |
	aList _ FileDirectory default fileNamesMatching: '*', aSuffix.
	aList size > 0
		ifTrue:
			[aName _ (SelectionMenu selections: aList) startUpWithCaption: 'Choose a file' translated.
			^ aName]
		ifFalse:
			[self inform: 'Sorry, there are no files
whose names end with "', aSuffix, '".'.
			^ nil]! !