'From etoys3.0 of 24 February 2008 [latest update: #1986] on 1 May 2008 at 2:25:27 am'! "Change Set: transMisc30Apr08-KR Date: 30 April 2008 Author: Korakurider translate captions for #request:initialAnswer: #inform: and #confirm:trueChoice:falseChoice:"! !ButtonProperties methodsFor: 'menu' stamp: 'KR 4/30/2008 22:26'! setLabel | newLabel | newLabel _ FillInTheBlank request: 'Please a new label for this button' translated initialAnswer: self label. newLabel isEmpty ifFalse: [self label: newLabel]. ! ! !FileContentsBrowser methodsFor: 'class list' stamp: 'KR 4/30/2008 22:24'! renameClass | oldName newName | classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. oldName _ self selectedClass name. newName _ (self request: 'Please type new class name' translated initialAnswer: oldName) asSymbol. (newName isEmpty or:[newName = oldName]) ifTrue: [^ self]. (self selectedPackage classes includesKey: newName) ifTrue: [^ self error: newName , ' already exists in the package' translated]. systemOrganizer classify: newName under: self selectedSystemCategoryName. systemOrganizer removeElement: oldName. self selectedPackage renameClass: self selectedClass to: newName. self changed: #classList. self classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName) indexOf: newName). ! ! !FileContentsBrowser class methodsFor: 'file list services' stamp: 'KR 4/30/2008 22:23'! selectAndBrowseFile: aFileList "When no file are selected you can ask to browse several of them" | selectionPattern files | selectionPattern := FillInTheBlank request:'What files?' translated initialAnswer: '*.cs;*.st'. files _ (aFileList directory fileNamesMatching: selectionPattern) collect: [:each | aFileList directory fullNameFor: each]. self browseFiles: files. ! ! !FileList methodsFor: 'volume list and pattern' stamp: 'KR 5/1/2008 01:37'! deleteDirectory "Remove the currently selected directory" | localDirName | directory entries size = 0 ifFalse:[^self inform:'Directory must be empty' translated]. localDirName _ directory localName. (self confirm: ('Really delete {1}?' translated format: {localDirName})) ifFalse: [^ self]. self volumeListIndex: self volumeListIndex-1. directory deleteDirectory: localDirName. self updateFileList.! ! !Morph methodsFor: 'e-toy support' stamp: 'KR 5/1/2008 02:09'! definePath | points lastPoint aForm offset currentPoint dwell ownerPosition | points _ OrderedCollection new: 70. lastPoint _ nil. aForm _ self imageForm. offset _ aForm extent // 2. ownerPosition _ owner position. Cursor move show. Sensor waitButton. [Sensor anyButtonPressed and: [points size < 100]] whileTrue: [currentPoint _ Sensor cursorPoint. dwell _ 0. currentPoint = lastPoint ifTrue: [dwell _ dwell + 1. ((dwell \\ 1000) = 0) ifTrue: [Beeper beep]] ifFalse: [self position: (currentPoint - offset). self world displayWorld. (Delay forMilliseconds: 20) wait. points add: currentPoint. lastPoint _ currentPoint]]. points size > 1 ifFalse: [self inform: 'no path obtained' translated] ifTrue: [points size = 100 ifTrue: [self playSoundNamed: 'croak']. "Transcript cr; show: 'path defined with ', points size printString, ' points'." self renderedMorph setProperty: #pathPoints toValue: (points collect: [:p | p - ownerPosition])]. Cursor normal show ! ! !Morph methodsFor: 'fileIn/out' stamp: 'KR 4/30/2008 22:14'! saveOnURLbasic "Ask the user for a url and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out." | url pg stamp pol | (pg := self valueOfProperty: #SqueakPage) ifNil: [pg := SqueakPage new] ifNotNil: [pg contentsMorph ~~ self ifTrue: [self inform: 'morph''s SqueakPage property is out of date' translated. pg := SqueakPage new]]. (url := pg url) ifNil: [url := ServerDirectory defaultStemUrl , '1.sp'. "A new legal place" url := FillInTheBlank request: 'url of a place to store this object. Must begin with file:// or ftp://' translated initialAnswer: url. url isEmpty ifTrue: [^#cancel]]. stamp := Utilities authorInitialsPerSe ifNil: ['*']. pg saveMorph: self author: stamp. SqueakPageCache atURL: url put: pg. "setProperty: #SqueakPage" (pol := pg policy) ifNil: [pol := #neverWrite]. pg policy: #now; dirty: true. pg write. "force the write" pg policy: pol. ^pg! ! !AnonymousSoundMorph methodsFor: 'menu' stamp: 'KR 4/30/2008 22:28'! addToSoundLibrary "Add the receiver's sound to the library, and hand the user a tile representing it." | aName tile | aName := FillInTheBlank request: 'kindly give the sound a name: ' translated initialAnswer: (interimName ifNil: ['']). aName isEmptyOrNil ifTrue: [^ self]. aName := SampledSound unusedSoundNameLike: aName. SampledSound addLibrarySoundNamed: aName samples: sound samples samplingRate: sound samplingRate. tile _ SoundTile new literal: aName. tile bounds: tile fullBounds. tile center: self fullBoundsInWorld center. (ScriptingTileHolder around: tile) center: self fullBoundsInWorld center; openInWorld. self delete! ! !AudioChatGUI methodsFor: 'sending' stamp: 'KR 5/1/2008 01:25'! send | null rawSound aSampledSound | mytargetip isEmpty ifTrue: [ ^self inform: 'You must connect with someone first.' translated. ]. rawSound _ myrecorder recorder recordedSound ifNil: [^self]. aSampledSound _ rawSound asSampledSound. "Smalltalk at: #Q3 put: {rawSound. rawSound asSampledSound. aCompressedSound}." self transmitWhileRecording ifTrue: [ self sendOneOfMany: rawSound asSampledSound. queueForMultipleSends ifNotNil: [queueForMultipleSends nextPut: nil]. queueForMultipleSends _ nil. ^self ]. null _ String with: 0 asCharacter. EToyPeerToPeer new sendSomeData: { EToyIncomingMessage typeAudioChat,null. Preferences defaultAuthorName,null. aSampledSound originalSamplingRate asInteger printString,null. (mycodec compressSound: aSampledSound) channels first. } to: mytargetip for: self. ! ! !BasicButton methodsFor: 'as yet unclassified' stamp: 'KR 4/30/2008 22:02'! setLabel | newLabel | newLabel _ FillInTheBlank request: 'Enter a new label for this button' translated initialAnswer: self label. newLabel isEmpty ifFalse: [self label: newLabel font: nil]. ! ! !BookMorph methodsFor: 'sorting' stamp: 'KR 5/1/2008 01:26'! acceptSortedContentsFrom: aHolder "Update my page list from the given page sorter." | goodPages rejects toAdd sqPage | goodPages := OrderedCollection new. rejects := OrderedCollection new. aHolder submorphs doWithIndex: [:m :i | toAdd := nil. (m isKindOf: PasteUpMorph) ifTrue: [ toAdd := m. toAdd removeProperty: #revertKey]. (m isKindOf: BookPageThumbnailMorph) ifTrue: [toAdd := m page. m bookMorph == self ifFalse: ["borrowed from another book. preserve the original" toAdd := toAdd veryDeepCopy. "since we came from elsewhere, cached strings are wrong" self removeProperty: #allTextUrls. self removeProperty: #allText. "page moved to this book forgets it's original for revertion" toAdd removeProperty: #revertKey]]. toAdd isString ifTrue: ["a url" toAdd := pages detect: [:aPage | aPage url = toAdd] ifNone: [toAdd]]. toAdd isString ifTrue: [sqPage := SqueakPageCache atURL: toAdd. toAdd := sqPage contentsMorph ifNil: [sqPage copyForSaving "a MorphObjectOut"] ifNotNil: [sqPage contentsMorph]]. toAdd ifNil: [rejects add: m] ifNotNil: [goodPages add: toAdd]]. self newPages: goodPages. goodPages isEmpty ifTrue: [self insertPage]. rejects notEmpty ifTrue: [ self inform: rejects size printString , ' objects vanished in this process.' translated]! ! !BouncingAtomsMorph methodsFor: 'menu' stamp: 'KR 4/30/2008 22:27'! setAtomCount | countString count | countString _ FillInTheBlank request: 'Number of atoms?' translated initialAnswer: self submorphCount printString. countString isEmpty ifTrue: [^ self]. count _ Integer readFrom: (ReadStream on: countString). self removeAllMorphs. self addAtoms: count. ! ! !EnvelopeEditorMorph methodsFor: 'initialization' stamp: 'KR 5/1/2008 01:32'! editSound: aSound | p | (aSound respondsTo: #envelopes) ifFalse: [ PopUpMenu inform: ('You selected a {1}. I can''t handle these kinds of sounds.' translated format: { aSound class name }). ^self ]. sound _ aSound. sound envelopes isEmpty ifTrue: [ "provide a default volume envelope" p _ OrderedCollection new. p add: 0@0.0; add: 10@1.0; add: 100@1.0; add: 120@0.0. sound addEnvelope: (VolumeEnvelope points: p loopStart: 2 loopEnd: 3)]. self editEnvelope: sound envelopes first. keyboard soundPrototype: sound. ! ! !EnvelopeEditorMorph methodsFor: 'menu' stamp: 'KR 4/30/2008 22:25'! adjustScale: evt | scaleString oldScale baseValue | oldScale := envelope scale. scaleString := FillInTheBlank request: 'Enter the new full-scale value...' translated initialAnswer: oldScale printString. scaleString isEmpty ifTrue: [^self]. envelope scale: (Number readFrom: scaleString) asFloat. baseValue := envelope updateSelector = #pitch: ifTrue: [0.5] ifFalse: [0.0]. envelope setPoints: (envelope points collect: [:p | p x @ ((p y - baseValue) * oldScale / envelope scale + baseValue min: 1.0 max: 0.0)]) loopStart: (limits first) loopEnd: (limits second). self buildView! ! !EnvelopeEditorMorph methodsFor: 'menu' stamp: 'KR 5/1/2008 01:33'! saveLibToDisk: evt "Save the library to disk" | newName f snd | newName _ FillInTheBlank request: 'Please confirm name for library...' translated initialAnswer: 'MySounds'. newName isEmpty ifTrue: [^ self]. f _ FileStream newFileNamed: newName , '.fml'. AbstractSound soundNames do: [:name | snd _ AbstractSound soundNamed: name. "snd isStorable" true ifTrue: [f nextChunkPut: 'AbstractSound soundNamed: ' , name , ' put: ' , snd storeString; cr; cr] ifFalse: [self inform: ('{1} is not currently storable' translated format: {name}) ]]. f close! ! !EnvelopeEditorMorph methodsFor: 'menu' stamp: 'KR 4/30/2008 22:25'! saveSound: evt | newName | newName _ FillInTheBlank request: 'Please confirm name for save...' translated initialAnswer: soundName. newName isEmpty ifTrue: [^ self]. AbstractSound soundNamed: newName put: sound. soundName _ newName.! ! !EnvelopeEditorMorph methodsFor: 'menu' stamp: 'KR 4/30/2008 22:25'! saveToDisk: evt | newName f | newName _ FillInTheBlank request: 'Please confirm name for save...' translated initialAnswer: soundName. newName isEmpty ifTrue: [^ self]. f _ FileStream newFileNamed: newName , '.fmp'. sound storeOn: f. f close! ! !EventRecorderMorph methodsFor: 'fileIn/Out' stamp: 'KR 4/30/2008 22:25'! readTape ^ self readTape: (FillInTheBlank request: 'Tape to read' translated initialAnswer: 'tapeName.tape').! ! !EventRecorderMorph methodsFor: 'fileIn/Out' stamp: 'KR 4/30/2008 22:24'! writeTape | args bb | bb _ self findDeepSubmorphThat: [:mm | (mm isKindOf: SimpleButtonMorph) and: [mm label = 'writeTape']] ifAbsent: [nil]. args := bb ifNil: [#()] ifNotNil: [bb arguments]. (args notEmpty and: [args first notEmpty]) ifTrue: [args first. self writeTape: args first] ifFalse: [^self writeTape: (FillInTheBlank request: 'Tape to write' translated initialAnswer: 'tapeName.tape')].! ! !EventRecordingSpace methodsFor: 'commands' stamp: 'KR 5/1/2008 02:13'! abandon "Abandon the entire exercise." (state ~= #readyToRecord and: [eventRecorder saved not]) ifTrue: [(PopUpMenu confirm: 'The current recording has not been saved, and will be lost if you do this; are you sure you want to proceed?' translated trueChoice: 'yes, abandon this Event Theatre' translated falseChoice: 'no, let me reconsider' translated) ifFalse: [^ self]]. eventRoll ifNotNil: [eventRoll delete]. eventRoll := nil. self topRendererOrSelf delete. self abandonReplayHandsAndHalos! ! !EventRecordingSpace methodsFor: 'commands' stamp: 'KR 4/30/2008 22:24'! setCaption "Interactively supply the caption,. Not currently called, as its entry in the tool's menu is for the moment commented out..." | aCaption aResult | eventRecorder ifNil: [^ self]. aCaption := eventRecorder caption ifNil: ['Your Title Goes Here' translated]. aResult := FillInTheBlank request: 'Please edit the caption' translated initialAnswer: aCaption. aResult isEmptyOrNil ifFalse: [eventRecorder caption: aResult. captionMorph contents: aResult] ! ! !EventRecordingSpace methodsFor: 'menu' stamp: 'KR 5/1/2008 01:34'! offerVersions "Offer the user the opportunity to revert to a prior version of a recorded event tape." | aList aMenu | aList := self priorVersions collect: [:v | v first]. aList ifEmpty: [^ self inform: 'no versions available, sorry' translated]. aMenu := MenuMorph new defaultTarget: self. aMenu addTitle: 'Choose a version to restore' translated. aList do: [:el | aMenu add: el printString selector: #restoreVersionStamped: argument: el]. aMenu popUpInWorld! ! !FlashButtonMorph methodsFor: 'menu' stamp: 'KR 4/30/2008 22:22'! addCustomAction | string code | string _ FillInTheBlank request:'Enter the Smalltalk code to execute:' translated initialAnswer:'Smalltalk beep.'. string isEmpty ifTrue:[^self]. string _ '[', string,']'. code _ Compiler evaluate: string for: self notifying: nil logged: false. self removeActions. target _ code. self on: #mouseDown send:(Message selector: #value).! ! !GraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'KR 5/1/2008 01:38'! findEntry "Prompt the user for a search string and find the next match for it" | toFind searchIndex | lastSearchString ifNil: [lastSearchString _ 'controls']. toFind _ FillInTheBlank request: 'Type name or fragment: ' translated initialAnswer: lastSearchString. toFind isEmptyOrNil ifTrue: [^ self]. lastSearchString _ toFind asLowercase. searchIndex _ currentIndex + 1. toFind _ '*', lastSearchString, '*'. [toFind match: (entryNames at: searchIndex) asString] whileFalse: [searchIndex _ (searchIndex \\ entryNames size) + 1. searchIndex == currentIndex ifTrue: [^ self inform: 'not found' translated]]. currentIndex _ searchIndex. self updateThumbnail! ! !GraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'KR 5/1/2008 01:38'! renameEntry | reply curr | reply _ FillInTheBlank request: 'New key? ' initialAnswer: (curr _ entryNames at: currentIndex) centerAt: self center. (reply isEmptyOrNil or: [reply = curr]) ifTrue: [^ Beeper beep]. (baseDictionary includesKey: reply) ifTrue: [^ self inform: 'sorry that conflicts with the name of another entry in this dictionary' translated]. baseDictionary at: reply put: (baseDictionary at: curr). baseDictionary removeKey: curr. self baseDictionary: baseDictionary. self updateThumbnail! ! !GraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'KR 5/1/2008 01:38'! renameGraphicTo: newName | curr | curr _ entryNames at: currentIndex. (newName isEmptyOrNil or: [newName = curr]) ifTrue: [^ Beeper beep]. (baseDictionary includesKey: newName) ifTrue: [^ self inform: 'sorry that conflicts with the name of another entry in this dictionary' translated]. baseDictionary at: newName put: (baseDictionary at: curr). baseDictionary removeKey: curr. self baseDictionary: baseDictionary. currentIndex _ entryNames indexOf: newName. self updateThumbnail! ! !ImageMorph methodsFor: 'menu commands' stamp: 'KR 4/30/2008 22:21'! readFromFile | fileName | fileName _ FillInTheBlank request: 'Please enter the image file name' translated initialAnswer: 'fileName'. fileName isEmpty ifTrue: [^ self]. self image: (Form fromFileNamed: fileName). ! ! !JoystickMorph methodsFor: 'menu' stamp: 'KR 4/30/2008 22:18'! trackRealJoystick | s | s _ FillInTheBlank request: 'Number of joystick to track?' translated initialAnswer: '1'. s isEmpty ifTrue: [^ self]. realJoystickIndex _ Number readFromString: s. self startStepping. ! ! !KedamaMorph methodsFor: 'menu' stamp: 'KR 4/30/2008 22:18'! setScale | reply | reply _ FillInTheBlank request: 'Set the number of pixels per patch (a number between 1 and 10)?' translated initialAnswer: pixelsPerPatch printString. reply isEmpty ifTrue: [^ self]. self pixelsPerPatch: reply asNumber. ! ! !KeyboardEventMorph methodsFor: 'menu commands' stamp: 'KR 4/30/2008 22:18'! changeCharacter "Allow the user to select a new character for the receiver." | result | result := FillInTheBlank request: 'New character? ' translated initialAnswer: character asString. result isEmptyOrNil ifTrue: [^ self]. result = character asString ifTrue: [^ self]. event keyValue: result first asciiValue. self eventRoll ifNotNilDo: [:r | r pushChangesBackToEventTheatre]! ! !LanguageEditor methodsFor: 'gui methods' stamp: 'KR 4/30/2008 22:18'! addTranslation "translate a phrase" | phrase | phrase := FillInTheBlank request: 'enter the original:' translated initialAnswer: ''. (phrase isNil or: [phrase = '']) ifTrue: ["" self beep. ^ self]. "" self translatePhrase: phrase! ! !LanguageEditor methodsFor: 'gui methods' stamp: 'KR 4/30/2008 22:17'! newTranslations "private - try to apply the translations as much as possible all over the image" | result newID | result := FillInTheBlank request: 'New locale ID string?' translated initialAnswer: Locale current determineLocaleID isoString. result isEmpty ifTrue: ["Do nothing" ^ self]. newID := LocaleID isoString: result. InternalTranslator newLocaleID: (LocaleID isoString: result). self class openOn: newID! ! !MonthMorph methodsFor: 'controls' stamp: 'KR 4/30/2008 22:17'! chooseYear | newYear yearString | newYear _ (SelectionMenu selections: {'today'} , (month year - 5 to: month year + 5) , {'other...'}) startUpWithCaption: 'Choose another year' translated. newYear ifNil: [^ self]. newYear isNumber ifTrue: [^ self month: (Month month: month monthName year: newYear)]. newYear = 'today' ifTrue: [^ self month: (Month starting: Date today)]. yearString _ FillInTheBlank request: 'Type in a year' translated initialAnswer: Date today year asString. yearString ifNil: [^ self]. newYear _ yearString asNumber. (newYear between: 0 and: 9999) ifTrue: [^ self month: (Month month: month monthName year: newYear)]. ! ! !Morph class methodsFor: 'fileIn/Out' stamp: 'KR 5/1/2008 01:41'! fromFileName: fullName "Reconstitute a Morph from the file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world" | aFileStream morphOrList | aFileStream _ (MultiByteBinaryOrTextStream with: ((FileStream readOnlyFileNamed: fullName) binary contentsOfEntireFile)) binary reset. morphOrList _ aFileStream fileInObjectAndCode. (morphOrList isKindOf: SqueakPage) ifTrue: [morphOrList _ morphOrList contentsMorph]. Smalltalk isMorphic ifTrue: [ActiveWorld addMorphsAndModel: morphOrList] ifFalse: [morphOrList isMorph ifFalse: [self inform: 'Can only load a single morph into an mvc project via this mechanism.' translated]. morphOrList openInWorld]. ^ morphOrList. ! ! !BookMorph class methodsFor: 'fileIn/Out' stamp: 'KR 5/1/2008 01:27'! openFromFile: fullName "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world" | book aFileStream | Smalltalk verifyMorphicAvailability ifFalse: [^ self]. aFileStream _ FileStream readOnlyFileNamed: fullName. book _ BookMorph new. book setProperty: #url toValue: aFileStream url. book fromRemoteStream: aFileStream. aFileStream close. Smalltalk isMorphic ifTrue: [ActiveWorld addMorphsAndModel: book] ifFalse: [book isMorph ifFalse: [^self inform: 'Can only load a single morph into an mvc project via this mechanism.' translated]. book openInWorld]. book goToPage: 1! ! !BookMorph class methodsFor: 'url' stamp: 'KR 5/1/2008 01:27'! alreadyInFromUrl: aUrl "Does a bookMorph living in some world in this image represent the same set of server pages? If so, don't create another one. It will steal pages from the existing one. Go delete the first one." self withAllSubclassesDo: [:cls | cls allInstancesDo: [:aBook | (aBook valueOfProperty: #url) = aUrl ifTrue: [ aBook world ifNotNil: [ self inform: 'This book is already open in some project' translated. ^ true]]]]. ^ false! ! !BookMorph class methodsFor: 'url' stamp: 'KR 5/1/2008 01:27'! isInWorld: aWorld withUrl: aUrl | urls bks short | "If a book with this url is in the that (current) world, return it. Say if it is out or in another world." urls _ OrderedCollection new. bks _ OrderedCollection new. aWorld allMorphsDo: [:aBook | (aBook isKindOf: BookMorph) ifTrue: [ bks add: aBook. (urls add: (aBook valueOfProperty: #url)) = aUrl ifTrue: [ aBook world == aWorld ifTrue: [^ aBook]]]]. "shortcut" self withAllSubclassesDo: [:cls | cls allInstancesDo: [:aBook | (aBook valueOfProperty: #url) = aUrl ifTrue: [ aBook world == aWorld ifTrue: [^ aBook] ifFalse: [ self inform: 'Book may be open in some other project' translated. ^ aBook]]]]. "if same book name, use it" short _ (aUrl findTokens: '/') last. urls withIndexDo: [:kk :ind | (kk findTokens: '/') last = short ifTrue: [ ^ bks at: ind]]. ^ #out! ! !GraphicalDictionaryMenu class methodsFor: 'instance creation' stamp: 'KR 5/1/2008 01:38'! openOn: aFormDictionary withLabel: aLabel "open a graphical dictionary in a window having the label aLabel. aFormDictionary should be a dictionary containing as value a form." | inst aWindow | aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!' translated]. inst := self new initializeFor: nil fromDictionary: aFormDictionary. aWindow _ (SystemWindow labelled: aLabel) model: inst. aWindow addMorph: inst frame: (0@0 extent: 1@1). aWindow extent: inst fullBounds extent + (3 @ aWindow labelHeight + 3); minimumExtent: inst minimumExtent + (3 @ aWindow labelHeight + 3). HandMorph attach: aWindow. ^ inst! ! !MPEGDisplayMorph methodsFor: 'commands' stamp: 'KR 5/1/2008 01:42'! startPlaying "Start playing the movie at the current position." | frameIndex | self stopPlaying. stopFrame _ nil. self mpegFileIsOpen ifFalse: [^ self]. (FileStream isAFileNamed: mpegFile fileName) ifFalse: [ | newFileResult newFileName | self inform: 'Path changed. Enter new one for: ' translated, (FileDirectory localNameFor: mpegFile fileName). newFileResult _ StandardFileMenu oldFile. newFileName _ newFileResult directory fullNameFor: newFileResult name. mpegFile openFile: newFileName]. mpegFile hasAudio ifTrue: [mpegFile hasVideo ifTrue: ["set movie frame position from soundTrack position" soundTrack reset. "ensure file is open before positioning" soundTrack soundPosition: (mpegFile videoGetFrame: 0) asFloat / (mpegFile videoFrames: 0). "now set frame index from the soundtrack position for best sync" frameIndex _ ((soundTrack millisecondsSinceStart * desiredFrameRate) // 1000). frameIndex _ (frameIndex max: 0) min: ((mpegFile videoFrames: 0) - 3). mpegFile videoSetFrame: frameIndex stream: 0]. SoundPlayer stopReverb. soundTrack volume: volume. soundTrack repeat: repeat. soundTrack resumePlaying. startFrame _ startMSecs _ 0] ifFalse: [soundTrack _ nil. startFrame _ mpegFile videoGetFrame: 0. startMSecs _ Time millisecondClockValue]. running _ true! ! !NCAAConnectorMorph methodsFor: 'menus' stamp: 'KR 4/30/2008 22:13'! changeBorderWidth: evt "Copied from BorderedMorph" | newWidth | (owner notNil and: [self visible]) ifTrue: [^self changeBorderWidthInteractively: evt]. newWidth := FillInTheBlank request: 'New line border width?' translated initialAnswer: self borderWidth asString. newWidth isEmpty ifTrue: [ ^self ]. newWidth := newWidth asNumber. self borderWidth: newWidth! ! !NCAAConnectorMorph methodsFor: 'menus' stamp: 'KR 4/30/2008 22:13'! changeLineWidth: evt "Copied from BorderedMorph" | newWidth | (owner notNil and: [self visible]) ifTrue: [^self changeLineWidthInteractively: evt]. newWidth := FillInTheBlank request: 'New line width?' translated initialAnswer: self lineWidth asString. newWidth isEmpty ifTrue: [ ^self ]. newWidth := newWidth asNumber. self lineWidth: newWidth! ! !NCButtonBar methodsFor: 'menus' stamp: 'KR 4/30/2008 22:12'! changeLabel | label labelString | label _ self label. label ifNil: [ ^self ]. labelString _ FillInTheBlank request: 'Enter label:' translated initialAnswer: label contents. labelString isEmpty ifFalse: [ label contents: labelString ]! ! !NCGlyphEditor methodsFor: 'accessing' stamp: 'KR 5/1/2008 01:43'! font: aFont glyph := nil. transform := nil. endPoint := nil. joinPoint := nil. sampleLine ifNotNilDo: [:s | s arrows: { nil. nil}]. aFont isTTCFont ifFalse: [^self inform: 'You must choose a TrueType font' translated]. font := aFont ttcDescription. fontSample ifNotNil: [fontSample delete]. self addMorph: (fontSample := TTSampleFontMorph fontWithoutString: font) fullFrame: self fontFrame. fontSample on: #mouseUp send: #selectGlyphBlock:event:from: to: fontSample withValue: [:g | self glyph: g]. self changed! ! !NetNameResolver class methodsFor: 'lookups-old' stamp: 'KR 4/30/2008 22:12'! promptUserForHostAddressDefault: defaultName "Ask the user for a host name and return its address. If the default name is the empty string, use the last host name as the default." "NetNameResolver promptUserForHostAddressDefault: ''" | default hostName serverAddr | defaultName isEmpty ifTrue: [default _ DefaultHostName] ifFalse: [default _ defaultName]. hostName _ FillInTheBlank request: 'Host name or address?' translated initialAnswer: default. hostName isEmpty ifTrue: [^ 0]. serverAddr _ NetNameResolver addressForName: hostName timeout: 15. hostName size > 0 ifTrue: [DefaultHostName _ hostName]. ^ serverAddr! ! !ParagraphEditor methodsFor: 'menu messages' stamp: 'KR 5/1/2008 01:45'! saveContentsInFile "Save the receiver's contents string to a file, prompting the user for a file-name. Suggest a reasonable file-name." | fileName stringToSave parentWindow labelToUse suggestedName lastIndex | stringToSave _ paragraph text string. stringToSave size == 0 ifTrue: [^ self inform: 'nothing to save.' translated]. parentWindow _ self model dependents detect: [:dep | dep isKindOf: SystemWindow orOf: StandardSystemView] ifNone: [nil]. labelToUse _ parentWindow ifNil: ['Untitled'] ifNotNil: [parentWindow label]. suggestedName _ nil. #(('Decompressed contents of: ' '.gz')) do: "can add more here..." [:leaderTrailer | (labelToUse beginsWith: leaderTrailer first) ifTrue: [suggestedName _ labelToUse copyFrom: leaderTrailer first size + 1 to: labelToUse size. (labelToUse endsWith: leaderTrailer last) ifTrue: [suggestedName _ suggestedName copyFrom: 1 to: suggestedName size - leaderTrailer last size] ifFalse: [lastIndex _ suggestedName lastIndexOf: $. ifAbsent: [0]. (lastIndex = 0 or: [lastIndex = 1]) ifFalse: [suggestedName _ suggestedName copyFrom: 1 to: lastIndex - 1]]]]. suggestedName ifNil: [suggestedName _ labelToUse, '.text']. fileName _ FillInTheBlank request: 'File name?' translated initialAnswer: suggestedName. fileName isEmptyOrNil ifFalse: [(FileStream newFileNamed: fileName) nextPutAll: stringToSave; close]! ! !ParagraphEditor methodsFor: 'menu messages' stamp: 'KR 5/1/2008 01:45'! sendContentsToPrinter | textToPrint printer parentWindow | textToPrint := paragraph text. textToPrint size == 0 ifTrue: [^self inform: 'nothing to print.' translated]. printer := TextPrinter defaultTextPrinter. parentWindow := self model dependents detect: [:dep | dep isSystemWindow] ifNone: [nil]. parentWindow isNil ifTrue: [printer documentTitle: 'Untitled'] ifFalse: [printer documentTitle: parentWindow label]. printer printText: textToPrint! ! !PasteUpMorph methodsFor: 'painting' stamp: 'KR 5/1/2008 01:46'! deleteBackgroundPainting backgroundMorph ifNotNil: [backgroundMorph delete. backgroundMorph _ nil] ifNil: [self inform: 'There is presently no background painting to delete.' translated]! ! !Player methodsFor: 'scripts-kernel' stamp: 'KR 5/1/2008 01:52'! slotInfoButtonHitFor: aGetterSymbol inViewer: aViewer "The user made a gesture asking for slot menu for the given getter symbol in a viewer; put up the menu." | aMenu slotSym aType typeVocab interface selector | (#(+ - * /) includes: aGetterSymbol) ifTrue: [^ self inform: ('{1} is used for vector operations' translated format: {aGetterSymbol})]. slotSym _ Utilities inherentSelectorForGetter: aGetterSymbol. aType _ self typeForSlotWithGetter: aGetterSymbol asSymbol. aMenu _ MenuMorph new defaultTarget: self. interface := aViewer currentVocabulary methodInterfaceAt: aGetterSymbol ifAbsent: [nil]. selector := interface isNil ifTrue: [slotSym asString] ifFalse: [interface selector]. aType = #Patch ifTrue: [ aMenu add: 'grab morph' translated target: (self perform: aGetterSymbol) selector: #grabPatchMorph argument: #(). aMenu addLine. ]. (typeVocab _ Vocabulary vocabularyForType: aType) addWatcherItemsToMenu: aMenu forGetter: aGetterSymbol. (self slotInfo includesKey: slotSym) ifTrue: [aMenu add: 'change value type' translated selector: #chooseSlotTypeFor: argument: aGetterSymbol. typeVocab addUserSlotItemsTo: aMenu slotSymbol: slotSym. aMenu add: ('remove "{1}"' translated format: {slotSym}) selector: #removeSlotNamed: argument: slotSym. aMenu add: ('rename "{1}"' translated format: {slotSym}) selector: #renameSlot: argument: slotSym. aMenu addLine]. typeVocab addExtraItemsToMenu: aMenu forSlotSymbol: slotSym. "e.g. Player type adds hand-me-tiles" self addIdiosyncraticMenuItemsTo: aMenu forSlotSymol: slotSym. aMenu items isEmpty ifTrue: [aMenu add: 'ok' translated action: #yourself]. aMenu popUpForHand: aViewer primaryHand in: aViewer world! ! !Player methodsFor: 'slots-user' stamp: 'KR 5/1/2008 01:48'! basicRenameSlot: oldSlotName newSlotName: newSlotName "Give an existing instance variable a new name" self class renameSilentlyInstVar: oldSlotName to: newSlotName. self renameSlotInWatchersOld: oldSlotName new: newSlotName. self regenerateScripts. self updateAllViewers. self presenter allExtantPlayers do: [:aPlayer | (aPlayer hasScriptReferencing: oldSlotName ofPlayer: self) ifTrue: [aPlayer noteRenameOf: oldSlotName to: newSlotName inPlayer: self]]. self presenter hasAnyTextuallyCodedScripts ifTrue: [self inform: 'Caution!! References in texutally coded scripts won''t be renamed.' translated]. ^ true! ! !Player methodsFor: '*customevents-scripts-kernel' stamp: 'KR 5/1/2008 01:51'! runScript: aSelector "Called from script-activation buttons. Provides a safe way to run a script that may have changed its name" (self respondsTo: aSelector) ifTrue: [^ self triggerScript: aSelector]. self inform: ('Oops, object "{1}" no longer has a script named "{2}". It must have been deleted or renamed.' translated format: {self externalName. aSelector}) ! ! !PlayerSurrogate methodsFor: 'menu' stamp: 'KR 4/30/2008 22:08'! renamePlayer "Rename the player I represent." | result | result := FillInTheBlank request: 'Type new name:' translated initialAnswer: playerRepresented knownName. result isEmptyOrNil ifFalse: [playerRepresented tryToRenameTo: result]! ! !Preferences class methodsFor: 'misc' stamp: 'KR 5/1/2008 01:53'! browseThemes "Open up a message-category browser on the theme-defining methods" | aBrowser | aBrowser _ Browser new setClass: Preferences class selector: #outOfTheBox. aBrowser messageCategoryListIndex: ((Preferences class organization categories indexOf: 'themes' ifAbsent: [^ self inform: 'no themes found' translated]) + 1). Browser openBrowserView: (aBrowser openMessageCatEditString: nil) label: 'Preference themes' "Preferences browseThemes"! ! !Preferences class methodsFor: 'personalization' stamp: 'KR 5/1/2008 01:54'! restorePersonalPreferences "Restore all the user's saved personal preference settings" | savedPrefs | savedPrefs _ self parameterAt: #PersonalDictionaryOfPreferences ifAbsent: [^ self inform: 'There are no personal preferences saved in this image yet' translated]. savedPrefs associationsDo: [:assoc | (self preferenceAt: assoc key ifAbsent: [nil]) ifNotNilDo: [:pref | pref preferenceValue: assoc value preferenceValue]]! ! !Preferences class methodsFor: 'personalization' stamp: 'KR 5/1/2008 01:54'! restorePreferencesFromDisk (FileDirectory default fileExists: 'my.prefs') ifTrue: [ Cursor wait showWhile: [ [ self loadPreferencesFrom: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error restoring the preferences' translated] ] ] ifFalse: [ self inform: 'you haven''t saved your preferences yet!!' translated]. ! ! !Preferences class methodsFor: 'personalization' stamp: 'KR 5/1/2008 01:54'! storePreferencesToDisk Cursor wait showWhile: [ [ self storePreferencesIn: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error storing your preferences to disk' translated]]! ! !Presenter methodsFor: 'playerList' stamp: 'KR 5/1/2008 01:54'! browseAllScriptsTextually "Open a method-list browser on all the scripts in the project" | aList aMethodList | self flushPlayerListCache. "Just to be certain we get everything" (aList _ self uniclassesAndCounts) size == 0 ifTrue: [^ self inform: 'there are no scripted players' translated]. aMethodList _ OrderedCollection new. aList do: [:aPair | aPair first addMethodReferencesTo: aMethodList]. aMethodList size > 0 ifFalse: [^ self inform: 'there are no scripts in this project!!' translated]. SystemNavigation new browseMessageList: aMethodList name: 'All scripts in this project' autoSelect: nil " ActiveWorld presenter browseAllScriptsTextually "! ! !ProgressBarMorph methodsFor: 'menu' stamp: 'KR 4/30/2008 22:07'! changeProgressValue: evt | answer | answer _ FillInTheBlank request: 'Enter new value (0 - 1.0)' translated initialAnswer: self value contents asString. answer isEmptyOrNil ifTrue: [^ self]. self value contents: answer asNumber! ! !Project methodsFor: 'initialization' stamp: 'KR 5/1/2008 01:57'! windowReqNewLabel: newLabel newLabel isEmpty ifTrue: [^ false]. newLabel = changeSet name ifTrue: [^ true]. (ChangeSorter changeSetNamed: newLabel) == nil ifFalse: [self inform: 'Sorry that name is already used' translated. ^ false]. changeSet name: newLabel. ^ true! ! !Project methodsFor: 'file in/out' stamp: 'KR 5/1/2008 01:55'! armsLengthCommand: aCommand withDescription: aString | pvm tempProject foolingForm tempCanvas bbox crossHatchColor stride | "Set things up so that this aCommand is sent to self as a message after jumping to the parentProject. For things that can't be executed while in this project, such as saveAs, loadFromServer, storeOnServer. See ProjectViewMorph step." self isMorphic ifTrue: [ world borderWidth: 0. "get rid of the silly default border" tempProject _ Project newMorphic. foolingForm _ world imageForm. "make them think they never left" tempCanvas _ foolingForm getCanvas. bbox _ foolingForm boundingBox. crossHatchColor _ Color blue alpha: 0.3. stride _ 30. 10 to: bbox width by: stride do: [ :x | tempCanvas fillRectangle: (x@0 extent: 2@bbox height) fillStyle: crossHatchColor. ]. 10 to: bbox height by: stride do: [ :y | tempCanvas fillRectangle: (0@y extent: bbox width@2) fillStyle: crossHatchColor. ]. tempProject world color: (InfiniteForm with: foolingForm). tempProject projectParameters at: #armsLengthCmd put: ( DoCommandOnceMorph new addText: aString; actionBlock: [ self doArmsLengthCommand: aCommand. ] fixTemps ). tempProject projectParameters at: #deleteWhenEnteringNewProject put: true. tempProject enter. ] ifFalse: [ parentProject ifNil: [^ self inform: 'The top project can''t do that' translated]. pvm _ parentProject findProjectView: self. pvm armsLengthCommand: {self. aCommand}. self exit. ]. ! ! !Project methodsFor: 'file in/out' stamp: 'KR 5/1/2008 01:57'! revert | | "Exit this project and do not save it. Warn user unless in dangerous projectRevertNoAsk mode. Exit to the parent project. Do a revert on a clone of the segment, to allow later reverts." projectParameters ifNil: [^ self inform: 'nothing to revert to' translated]. parentProject enter: false revert: true saveForRevert: false. "does not return!!" ! ! !Project methodsFor: 'isolation layers' stamp: 'KR 5/1/2008 01:55'! beIsolated "Establish an isolation layer at this project. This requires clearing the current changeSet or installing a new one." isolatedHead ifTrue: [^ self error: 'Already isolated']. self isCurrentProject ifFalse: [^ self inform: 'Must be in this project to isolate it' translated.]. changeSet isEmpty ifFalse: [changeSet _ ChangeSorter newChangeSet]. changeSet beIsolationSetFor: self. isolatedHead _ true. inForce _ true. environment _ Environment new setName: self name outerEnvt: Smalltalk. ! ! !Project class methodsFor: 'squeaklet on server' stamp: 'KR 5/1/2008 01:58'! mostRecent: projName onServer: aServerDirectory | stem list max goodName triple num stem1 stem2 rawList nothingFound unEscName | "Find the exact fileName of the most recent version of project with the stem name of projName. Names are of the form 'projName|mm.pr' where mm is a mime-encoded integer version number. File names may or may not be HTTP escaped, %20 on the server." self flag: #bob. "do we want to handle unversioned projects as well?" "I think we do now - Yoshiki." nothingFound _ {nil. -1}. aServerDirectory ifNil: [^nothingFound]. "23 sept 2000 - some old projects have periods in name so be more careful" unEscName _ projName unescapePercents. triple _ Project parseProjectFileName: unEscName. stem _ triple first. rawList _ aServerDirectory fileNames. rawList isString ifTrue: [self inform: 'server is unavailable' translated. ^nothingFound]. list _ rawList collect: [:nnn | nnn unescapePercents]. max _ -1. goodName _ nil. list withIndexDo: [:aName :ind | ((aName beginsWith: stem)) ifTrue: [ ((aName endsWith: triple last) or: [triple last = '' and: [aName endsWith: '.pr']]) ifTrue: [ num _ (Project parseProjectFileName: aName) second. num > max ifTrue: [max _ num. goodName _ (rawList at: ind)]]]]. max = -1 ifFalse: [^ Array with: goodName with: max]. "try with underbar for spaces on server" (stem includes: $ ) ifTrue: [ stem1 _ stem copyReplaceAll: ' ' with: '_'. list withIndexDo: [:aName :ind | (aName beginsWith: stem1) ifTrue: [ num _ (Project parseProjectFileName: aName) second. num > max ifTrue: [max _ num. goodName _ (rawList at: ind)]]]]. max = -1 ifFalse: [^ Array with: goodName with: max]. "try without the marker | " stem1 _ stem allButLast, '.pr'. stem2 _ stem1 copyReplaceAll: ' ' with: '_'. "and with spaces replaced" list withIndexDo: [:aName :ind | (aName beginsWith: stem1) | (aName beginsWith: stem2) ifTrue: [ (triple _ aName findTokens: '.') size >= 2 ifTrue: [ max _ 0. goodName _ (rawList at: ind)]]]. "no other versions" max = -1 ifFalse: [^ Array with: goodName with: max]. ^nothingFound "no matches" ! ! !Project class methodsFor: 'squeaklet on server' stamp: 'KR 5/1/2008 01:58'! sweep: aServerDirectory | repository list parts ind entry projectName versions | "On the server, move all but the three most recent versions of each Squeaklet to a folder called 'older'" "Project sweep: ((ServerDirectory serverNamed: 'DaniOnJumbo') clone directory: '/vol0/people/dani/Squeaklets/2.7')" "Ensure the 'older' directory" (aServerDirectory includesKey: 'older') ifFalse: [aServerDirectory createDirectory: 'older']. repository _ aServerDirectory clone directory: aServerDirectory directory, '/older'. "Collect each name, and decide on versions" list _ aServerDirectory fileNames. list isString ifTrue: [^ self inform: 'server is unavailable' translated]. list _ list asSortedCollection asOrderedCollection. parts _ list collect: [:en | Project parseProjectFileName: en]. parts _ parts select: [:en | en third = 'pr']. ind _ 1. [entry _ list at: ind. projectName _ entry first asLowercase. versions _ OrderedCollection new. versions add: entry. [(ind _ ind + 1) > list size ifFalse: [(parts at: ind) first asLowercase = projectName ifTrue: [versions add: (parts at: ind). true] ifFalse: [false]] ifTrue: [false]] whileTrue. aServerDirectory moveYoungest: 3 in: versions to: repository. ind > list size] whileFalse. ! ! !ProjectHistory methodsFor: 'as yet unclassified' stamp: 'KR 4/30/2008 22:07'! mostRecentThread | projectNames threadName | self cleanUp. projectNames _ (mostRecent collect: [ :each | {each first} ]) reversed. threadName _ FillInTheBlank request: 'Please name this thread.' translated initialAnswer: 'Recent projects @ ',Time now printString. threadName isEmptyOrNil ifTrue: [^nil]. InternalThreadNavigationMorph know: projectNames as: threadName. ^threadName ! ! !ProjectLauncher methodsFor: 'eToy login' stamp: 'KR 5/1/2008 01:58'! loginAs: userName "Assuming that we have a valid user url; read its contents and see if the user is really there." | actualName userList | eToyAuthentificationServer ifNil:[ self proceedWithLogin. ^true]. userList _ eToyAuthentificationServer eToyUserList. userList ifNil:[ self inform: 'Sorry, I cannot find the user list. (this may be due to a network problem) Please hit Cancel if you wish to use Squeak.' translated. ^false]. "case insensitive search" actualName _ userList detect:[:any| any sameAs: userName] ifNone:[nil]. actualName isNil ifTrue:[ self inform: 'Unknown user: ' translated ,userName. ^false]. Utilities authorName: actualName. eToyAuthentificationServer eToyUserName: actualName. self proceedWithLogin. ^true! ! !ProjectView methodsFor: 'initialization' stamp: 'KR 5/1/2008 01:59'! relabel: newLabel (newLabel isEmpty or: [newLabel = self label]) ifTrue: [^ self]. (ChangeSorter changeSetNamed: newLabel) == nil ifFalse: [self inform: 'Sorry that name is already used' translated. ^ self]. model projectChangeSet name: newLabel. super relabel: newLabel! ! !ProjectViewMorph methodsFor: 'as yet unclassified' stamp: 'KR 5/1/2008 01:59'! editTheName: evt self isTheRealProjectPresent ifFalse: [ ^self inform: 'The project is not present and may not be renamed now' translated ]. self addProjectNameMorph launchMiniEditor: evt.! ! !ProjectViewMorph methodsFor: 'events' stamp: 'KR 5/1/2008 02:00'! enter "Enter my project." self world == self outermostWorldMorph ifFalse: [^Beeper beep]. "can't do this at the moment" project class == DiskProxy ifFalse: [(project world notNil and: [project world isMorph and: [project world hasOwner: self outermostWorldMorph]]) ifTrue: [^Beeper beep "project is open in a window already"]]. project class == DiskProxy ifTrue: ["When target is not in yet" self enterWhenNotPresent. "will bring it in" project class == DiskProxy ifTrue: [^self inform: 'Project not found' translated]]. (owner isSystemWindow) ifTrue: [project setViewSize: self extent]. self showMouseState: 3. project enter: false revert: false saveForRevert: false! ! !RecordingControls methodsFor: 'documentation' stamp: 'KR 4/30/2008 21:56'! putUpAndOpenHelpFlap "If appropriate, put up (if not already present) a flap giving documentation" | aFlap | aFlap := ScriptingSystem assureFlapOfLabel: 'Sound Recorder' translated withContents: self helpString. aFlap showFlap ! ! !RecordingControls methodsFor: 'documentation' stamp: 'KR 4/30/2008 21:57'! putUpHelpFlap "If appropriate, put up (if not alredy present) a flap giving documentation" (ScriptingSystem assureFlapOfLabel: 'Sound Recorder' translated withContents: self helpString) hideFlap ! ! !ReferenceMorph methodsFor: 'menu' stamp: 'KR 4/30/2008 22:06'! changeTabText | reply | reply _ FillInTheBlank request: 'new wording for this tab:' translated initialAnswer: submorphs first contents. reply isEmptyOrNil ifFalse: [submorphs first contents: reply]! ! !FlapTab methodsFor: 'solid tabs' stamp: 'KR 4/30/2008 22:22'! changeTabThickness | newThickness | newThickness := FillInTheBlank request: 'New thickness:' translated initialAnswer: self tabThickness printString. newThickness notEmpty ifTrue: [self applyTabThickness: newThickness]! ! !FlapTab methodsFor: 'submorphs-add/remove' stamp: 'KR 5/1/2008 02:20'! dismissViaHalo "Dismiss the receiver (and its referent), unless it resists" self resistsRemoval ifTrue: [(PopUpMenu confirm: 'Really throw this flap away' translated trueChoice: 'Yes' translated falseChoice: 'Um, no, let me reconsider' translated) ifFalse: [^ self]]. referent delete. self delete! ! !SampledSound class methodsFor: 'sound library' stamp: 'KR 5/1/2008 02:00'! soundNamed: aString "Answer the sound of the given name, or, if there is no sound of that name, put up an informer so stating, and answer nil" "(SampledSound soundNamed: 'shutterClick') play" ^ self soundNamed: aString ifAbsent: [self inform: aString, ' not found in the Sound Library' translated. nil]! ! !ScriptInstantiation methodsFor: '*customevents-status control' stamp: 'KR 5/1/2008 02:01'! defineNewEvent | newEventName newEventHelp | "Prompt the user for the name of a new event and install it into the custom event table" newEventName _ FillInTheBlankMorph request: 'What is the name of your new event?' translated. newEventName isEmpty ifTrue: [ ^self ]. newEventName _ newEventName asSymbol. (ScriptingSystem customEventStati includes: newEventName) ifTrue: [ self inform: 'That event is already defined.' translated. ^self ]. newEventHelp _ FillInTheBlankMorph request: 'Please describe this event:' translated. ScriptingSystem addUserCustomEventNamed: newEventName help: newEventHelp.! ! !SecurityManager methodsFor: 'security operations' stamp: 'KR 5/1/2008 02:21'! enterRestrictedMode "Some insecure contents was encountered. Close all doors and proceed." self isInRestrictedMode ifTrue:[^true]. (SugarLauncher isRunningInRainbow or: [Preferences securityChecksEnabled]) ifTrue: [^true]. "it's been your choice..." Preferences warnAboutInsecureContent ifTrue:[ (PopUpMenu confirm: 'You are about to load some insecure content. If you continue, access to files as well as some other capabilities will be limited.' translated trueChoice:'Load it anyways' translated falseChoice:'Do not load it' translated) ifFalse:[ "user doesn't really want it" ^false. ]. ]. "here goes the actual restriction" self flushSecurityKeys. self disableFileAccess. self disableImageWrite. "self disableSocketAccess." FileDirectory setDefaultDirectory: self untrustedUserDirectory. ^true ! ! !SimpleButtonMorph methodsFor: 'menu' stamp: 'KR 4/30/2008 22:03'! setLabel | newLabel | newLabel _ FillInTheBlank request: 'Please enter a new label for this button' translated initialAnswer: self label. newLabel isEmpty ifFalse: [self labelString: newLabel]. ! ! !NCMakerButton methodsFor: 'menus' stamp: 'KR 4/30/2008 22:12'! setActionSelector | newSel possibilities request | possibilities _ #(startWiring startWiringLabeled openInHand openInWorld) select: [ :ea | target respondsTo: ea ]. request _ 'Please type the selector to be sent to the target when this button is pressed. Some possibilities:' translated. possibilities do: [ :ea | request _ request, ' · ', ea ]. newSel _ FillInTheBlank request: request initialAnswer: actionSelector. newSel isEmpty ifFalse: [self actionSelector: newSel]. ! ! !ScriptActivationButton methodsFor: 'miscellaneous' stamp: 'KR 4/30/2008 22:02'! setLabel "Allow the user to enter a new label for this button" | newLabel existing | existing _ self label. newLabel _ FillInTheBlank request: 'Please enter a new label for this button' translated initialAnswer: existing. (newLabel isEmptyOrNil not and: [newLabel ~= existing]) ifTrue: [self setProperty: #labelManuallyEdited toValue: true. self label: newLabel font: Preferences standardEToysButtonFont]. ! ! !ScriptableButton methodsFor: 'menu' stamp: 'KR 4/30/2008 22:03'! setLabel "Invoked from a menu, let the user change the label of the button" | newLabel | newLabel _ FillInTheBlank request: 'Enter a new label for this button' translated initialAnswer: self label. newLabel isEmpty ifFalse: [self label: newLabel font: nil]. ! ! !SimpleSliderMorph methodsFor: 'menu' stamp: 'KR 4/30/2008 22:05'! setLabel | newLabel | newLabel _ FillInTheBlank request: 'Please a new label for this button' translated initialAnswer: self label. newLabel isEmpty ifFalse: [self label: newLabel]. ! ! !SoundLibraryTool methodsFor: 'menu' stamp: 'KR 4/30/2008 22:04'! loadSoundFromDisk "Put up a file chooser dialog inviting the user to import a sound file; accept it" | aSound aName aFileStream fullName ext reply | aFileStream := FileList2 modalFileSelectorForSuffixes: #(#AIFF #aiff #Wave #wav #wave ). aFileStream ifNil: [^ self]. fullName := aFileStream name. ('*.AIFF' match: fullName) ifTrue: [aSound := SampledSound fromAIFFfileNamed: fullName] ifFalse: [aSound := SampledSound fromWaveStream: aFileStream]. aFileStream close. ext := FileDirectory extensionFor: fullName. aName := (FileDirectory on: fullName) pathParts last. ext size > 0 ifTrue: [aName := aName copyFrom: 1 to: (aName size - (ext size + 1))]. [reply := FillInTheBlank request: 'Please give a name for this sound' translated initialAnswer: aName. reply isEmptyOrNil ifTrue: [^ self]. (SampledSound soundLibrary includesKey: reply) ifTrue: [self inform: 'sorry, that name is already taken' translated. false] ifFalse: [true]] whileFalse. SampledSound addLibrarySoundNamed: reply samples: aSound samples samplingRate: aSound originalSamplingRate! ! !StackMorph methodsFor: 'card access' stamp: 'KR 5/1/2008 02:03'! goToCard "prompt the user for an ordinal number, and use that as a basis for choosing a new card to install in the receiver" | reply index | reply _ FillInTheBlank request: 'Which card number? ' translated initialAnswer: '1'. reply isEmptyOrNil ifTrue: [^ self]. ((index _ reply asNumber) > 0 and: [index <= self privateCards size]) ifFalse: [^ self inform: 'no such card' translated]. self goToCard: (self privateCards at: index)! ! !SuperSwikiServer methodsFor: 'testing' stamp: 'KR 5/1/2008 02:05'! showQueryAsPVM: resultStream | answer gif whatToShow projectName fileName firstURL wrapper currX currY maxX maxY rawProjectName | "SuperSwikiServer testOnlySuperSwiki queryProjectsAndShow" resultStream reset; nextLine. answer _ RectangleMorph new useRoundedCorners; borderWidth: 0; borderColor: Color blue; color: Color paleBlue. currX _ currY _ maxX _ maxY _ 10. [resultStream atEnd] whileFalse: [ rawProjectName _ resultStream nextLine. projectName _ rawProjectName convertFromEncoding: self encodingName. fileName _ resultStream nextLine convertFromEncoding: self encodingName. gif _ self oldFileOrNoneNamed: rawProjectName,'.gif'. gif ifNotNil: [gif _ GIFReadWriter formFromStream: gif]. currX > 600 ifTrue: [ currX _ 10. currY _ maxY + 10. ]. gif ifNil: [ gif _ AlignmentMorph newColumn hResizing: #shrinkWrap; vResizing: #shrinkWrap; borderWidth: 8; borderColor: Color red; color: Color lightRed; addMorph: (StringMorph contents: 'No GIF for ',projectName); fullBounds; imageForm ]. firstURL _ self url. firstURL last == $/ ifFalse: [firstURL _ firstURL, '/']. whatToShow _ ProjectViewMorph new image: (gif asFormOfDepth: Display depth); lastProjectThumbnail: gif; setProperty: #SafeProjectName toValue: projectName; project: (DiskProxy global: #Project selector: #namedUrl: args: {firstURL,fileName} ). answer addMorphBack: (whatToShow position: currX @ currY). currX _ currX + whatToShow width + 10. maxX _ maxX max: currX. maxY _ maxY max: currY + whatToShow height. ]. maxX = 10 ifTrue: [ ^self inform: 'No projects found for your criteria' translated ]. answer extent: (maxX @ maxY) + (0@10). wrapper _ ScrollPane new extent: (answer width + 10) @ (answer height min: 400). wrapper color: Color white. wrapper scroller addMorph: answer. wrapper becomeModal; openCenteredInWorld; useRoundedCorners; setScrollDeltas.! ! !TheWorldMenu methodsFor: 'action' stamp: 'KR 5/1/2008 02:06'! projectThumbnail "Offer the user a menu of project names. Attach to the hand a thumbnail of the project the user selects." | menu projName pr | menu _ CustomMenu new. menu add: (CurrentProjectRefactoring currentProjectName, ' (current)') action: CurrentProjectRefactoring currentProjectName. menu addLine. Project allNames do: [:n | menu add: n action: n]. projName _ menu startUpWithCaption: 'Select a project' translated. projName ifNotNil: [(pr _ Project named: projName) ifNotNil: [myHand attachMorph: (ProjectViewMorph on: pr)] ifNil: [self inform: 'can''t seem to find that project' translated]].! ! !WsPhonePadMorph methodsFor: 'menu commands' stamp: 'KR 4/30/2008 21:54'! dialTo | dialNumberString | dialNumberString _ FillInTheBlank request: 'Phone number?' translated. dialNumberString isEmpty ifTrue: [^ self]. self dial: dialNumberString! ! !WsWorldStethoscope methodsFor: 'accessing' stamp: 'KR 5/1/2008 02:08'! rangeFinderModeOn rangeFinderMode := true. self cutOffLevel: 150000. self passOver: 600. self passUnder: 4000. self inform: 'You should adjust ''cut off level'' to find range well.' translated! !