'From Squeakland 3.8.5976 of 19 August 2004 [latest update: #243] on 22 August 2004 at 2:08:15 pm'! "Change Set: OtherSqueaklandFixes-nk Date: 21 August 2004 Author: Ned Konz Miscellaneous collected but uncategorized fixes. "! !ChangeSet methodsFor: 'fileIn/Out' stamp: 'nk 8/21/2004 14:51'! fileOut "File out the receiver, to a file whose name is a function of the change-set name and either of the date & time or chosen to have a unique numeric tag, depending on the preference 'changeSetVersionNumbers'" | slips nameToUse internalStream | self checkForConversionMethods. ChangeSet promptForDefaultChangeSetDirectoryIfNecessary. nameToUse := Preferences changeSetVersionNumbers ifTrue: [self defaultChangeSetDirectory nextNameFor: self name extension: FileStream cs] ifFalse: [self name , FileDirectory dot , Utilities dateTimeSuffix, FileDirectory dot , FileStream cs]. (Preferences warningForMacOSFileNameLength and: [nameToUse size > 30]) ifTrue: [nameToUse := FillInTheBlank request: (nameToUse , '\has ' , nameToUse size asString , ' letters - too long for Mac OS.\Suggested replacement is:') withCRs initialAnswer: (nameToUse contractTo: 30). nameToUse = '' ifTrue: [^ self]]. nameToUse := self defaultChangeSetDirectory fullNameFor: nameToUse. Cursor write showWhile: [ internalStream _ WriteStream on: (String new: 10000). internalStream header; timeStamp. self fileOutPreambleOn: internalStream. self fileOutOn: internalStream. self fileOutPostscriptOn: internalStream. internalStream trailer. FileStream writeSourceCodeFrom: internalStream baseName: (nameToUse copyFrom: 1 to: nameToUse size - 3) isSt: false useHtml: false. ]. Preferences checkForSlips ifFalse: [^ self]. slips := self checkForSlips. (slips size > 0 and: [(PopUpMenu withCaption: 'Methods in this fileOut have halts or references to the Transcript or other ''slips'' in them. Would you like to browse them?' chooseFrom: 'Ignore\Browse slips') = 2]) ifTrue: [self systemNavigation browseMessageList: slips name: 'Possible slips in ' , name]! ! !ComplexProgressIndicator methodsFor: 'as yet unclassified' stamp: 'nk 8/18/2004 16:43'! addProgressDecoration: extraParam | f m | targetMorph ifNil: [^self]. (extraParam isForm) ifTrue: [targetMorph submorphsDo: [:mm | (mm isSketchMorph) ifTrue: [mm delete]]. f := Form extent: extraParam extent depth: extraParam depth. extraParam displayOn: f. m := SketchMorph withForm: f. m align: m fullBounds leftCenter with: targetMorph fullBounds leftCenter + (2 @ 0). targetMorph addMorph: m. ^self]. (extraParam isString) ifTrue: [targetMorph submorphsDo: [:mm | (mm isKindOf: StringMorph) ifTrue: [mm delete]]. m := StringMorph contents: extraParam translated. m align: m fullBounds bottomCenter + (0 @ 8) with: targetMorph bounds bottomCenter. targetMorph addMorph: m. ^self]! ! !MethodInterface methodsFor: 'printing' stamp: 'nk 8/20/2004 09:38'! printOn: aStream "print the receiver on a stream. Overridden to provide details about wording, selector, result type, and companion setter." super printOn: aStream. aStream nextPutAll: ' - wording: '; print: self wording; nextPutAll: ' selector: '; print: selector. self argumentVariables size > 0 ifTrue: [aStream nextPutAll: ' Arguments: '. argumentVariables doWithIndex: [:aVariable :anIndex | aStream nextPutAll: 'argument #', anIndex printString, ' name = ', aVariable variableName asString, ', type = ', aVariable variableType]]. resultSpecification ifNotNil: [aStream nextPutAll: ' result type = ', resultSpecification resultType asString. resultSpecification companionSetterSelector ifNotNil: [aStream nextPutAll: ' setter = ', resultSpecification companionSetterSelector asString]] ! ! !MethodWithInterface methodsFor: 'initialization' stamp: 'nk 7/2/2004 07:18'! status ^defaultStatus ! ! !ParagraphEditor methodsFor: 'editing keys' stamp: 'nk 6/13/2004 11:32'! changeEmphasis: characterStream "Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change. Keeps typeahead." | keyCode attribute oldAttributes index thisSel colors extras | "control 0..9 -> 0..9" keyCode _ ('0123456789-=' indexOf: sensor keyboard ifAbsent: [1]) - 1. oldAttributes _ paragraph text attributesAt: self pointIndex forStyle: paragraph textStyle. thisSel _ self selection. "Decipher keyCodes for Command 0-9..." (keyCode between: 1 and: 5) ifTrue: [attribute _ TextFontChange fontNumber: keyCode]. keyCode = 6 ifTrue: [colors _ #(black magenta red yellow green blue cyan white). extras _ ((self class name = #TextMorphEditor) and: [(self morph isKindOf: TextMorphForEditView) not]) "not a system window" ifTrue: [#()] ifFalse: [#('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method')]. index _ (PopUpMenu labelArray: colors , #('choose color...' 'Do it' 'Print it'), extras, #('be a web URL link' 'Edit hidden info' 'Copy hidden info') lines: (Array with: colors size +1)) startUp. index = 0 ifTrue: [^ true]. index <= colors size ifTrue: [attribute _ TextColor color: (Color perform: (colors at: index))] ifFalse: [index _ index - colors size - 1. "Re-number!!!!!!" index = 0 ifTrue: [attribute _ self chooseColor]. index = 1 ifTrue: [attribute _ TextDoIt new. thisSel _ attribute analyze: self selection asString]. index = 2 ifTrue: [attribute _ TextPrintIt new. thisSel _ attribute analyze: self selection asString]. (extras size = 0) & (index > 2) ifTrue: [index _ index + 4]. "skip those" index = 3 ifTrue: [attribute _ TextLink new. thisSel _ attribute analyze: self selection asString with: 'Comment']. index = 4 ifTrue: [attribute _ TextLink new. thisSel _ attribute analyze: self selection asString with: 'Definition']. index = 5 ifTrue: [attribute _ TextLink new. thisSel _ attribute analyze: self selection asString with: 'Hierarchy']. index = 6 ifTrue: [attribute _ TextLink new. thisSel _ attribute analyze: self selection asString]. index = 7 ifTrue: [attribute _ TextURL new. thisSel _ attribute analyze: self selection asString]. index = 8 ifTrue: ["Edit hidden info" thisSel _ self hiddenInfo. "includes selection" attribute _ TextEmphasis normal]. index = 9 ifTrue: ["Copy hidden info" self copyHiddenInfo. ^ true]. "no other action" thisSel ifNil: [^ true]]. "Could not figure out what to link to" ]. (keyCode between: 7 and: 11) ifTrue: [sensor leftShiftDown ifTrue: [keyCode = 10 ifTrue: [attribute _ TextKern kern: -1]. keyCode = 11 ifTrue: [attribute _ TextKern kern: 1]] ifFalse: [attribute _ TextEmphasis perform: (#(bold italic narrow underlined struckOut) at: keyCode - 6). oldAttributes do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]]. (keyCode = 0) ifTrue: [attribute _ TextEmphasis normal]. beginTypeInBlock ~~ nil ifTrue: "only change emphasisHere while typing" [self insertTypeAhead: characterStream. emphasisHere _ Text addAttribute: attribute toArray: oldAttributes. ^ true]. self replaceSelectionWith: (thisSel asText addAttribute: attribute). ^ true! ! !Player methodsFor: 'misc' stamp: 'nk 8/18/2004 16:43'! adoptScriptsFrom "Let the user click on another object form which the receiver should obtain scripts and code" | aMorph | Sensor waitNoButton. aMorph _ ActiveWorld chooseClickTarget. aMorph ifNil: [^ Beeper beep]. (((aMorph isSketchMorph) and: [aMorph player belongsToUniClass]) and: [self belongsToUniClass not]) ifTrue: [costume acquirePlayerSimilarTo: aMorph player] ifFalse: [Beeper beep]! ! !Player methodsFor: 'slots-user' stamp: 'nk 8/21/2004 11:32'! tearOffFancyWatcherFor: aGetter "Hand the user a labeled readout for viewing a numeric value" | aWatcher aTile aLine aColor ms slotMsg info isNumeric anInterface watcherWording delta | info _ self slotInfoForGetter: aGetter. info ifNotNil: [isNumeric _ info type == #Number. watcherWording _ Utilities inherentSelectorForGetter: aGetter] ifNil: [anInterface _Vocabulary eToyVocabulary methodInterfaceAt: aGetter ifAbsent: [nil]. isNumeric _ anInterface notNil and: [anInterface resultType == #Number]. watcherWording _ anInterface wording]. aColor _ Color r: 0.387 g: 0.581 b: 1.0. aWatcher _ UpdatingStringMorph new. aWatcher growable: true; getSelector: aGetter; putSelector: (info notNil ifTrue: [ScriptingSystem setterSelectorForGetter: aGetter] ifFalse: [anInterface companionSetterSelector]). aWatcher target: self. isNumeric ifTrue: "at the moment, actually, only numeric is allowed" [aTile _ NumericReadoutTile new typeColor: aColor. self setFloatPrecisionFor: aWatcher. (delta _ self arrowDeltaFor: aGetter) ~= 1 ifTrue: [aTile setProperty: #arrowDelta toValue: delta]]. aTile addMorphBack: aWatcher. aTile addArrows. aTile setLiteralTo: (self perform: aGetter) width: 30. Preferences universalTiles ifTrue: [ ms _ MessageSend receiver: self selector: aGetter asSymbol arguments: #(). slotMsg _ ms asTilesIn: self class globalNames: (self class officialClass ~~ CardPlayer). "For CardPlayers, use 'self'. For others, name it, and use its name." ms _ MessageSend receiver: 3 selector: #= asSymbol arguments: #(5). aLine _ ms asTilesIn: self class globalNames: false. aLine firstSubmorph delete. aLine addMorphFront: slotMsg. aLine lastSubmorph delete. aLine lastSubmorph delete. aLine color: aColor. aLine addMorphBack: aTile. aLine cellPositioning: #leftCenter] ifFalse: [ aLine _ AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; color: aColor; layoutInset: -1; borderWidth: 1; borderColor: aColor darker; listCentering: #center. aLine addMorphBack: (self tileReferringToSelf borderWidth: 0; layoutInset: 4@0; typeColor: aColor; color: aColor; bePossessive). aLine addMorphBack: (StringMorph contents: watcherWording, ' = ' font: ScriptingSystem fontForTiles). aLine addMorphBack: aTile]. aWatcher step; fitContents. aLine openInHand! ! !ProcessBrowser methodsFor: 'process list' stamp: 'nk 6/30/2004 07:00'! prettyNameForProcess: aProcess | nameAndRules | aProcess ifNil: [ ^'' ]. nameAndRules _ self nameAndRulesFor: aProcess. ^ aProcess browserPrintStringWith: nameAndRules first! ! !SequenceableCollection methodsFor: 'accessing' stamp: 'nk 6/12/2004 17:06'! atLast: indexFromEnd "Return element at indexFromEnd from the last position. atLast: 1, returns the last element" ^ self atLast: indexFromEnd ifAbsent: [self error: 'index out of range']! ! !SystemDictionary methodsFor: 'sources, change log' stamp: 'nk 8/21/2004 15:55'! writeRecentCharacters: nCharacters toFileNamed: aFilename "Schedule an editable text view on the last n characters of changes." | changes | changes _ SourceFiles at: 2. changes setToEnd; skip: nCharacters negated. (StandardFileStream newFileNamed: aFilename) nextPutAll: (changes next: nCharacters); close; open; edit! ! !Vocabulary class methodsFor: 'standard vocabulary access' stamp: 'nk 8/22/2004 09:24'! vocabularyNamed: aName "Answer the standard vocabulary of the given name, or nil if none found" ^ self allStandardVocabularies at: aName asSymbol ifAbsent: []! ! !WaveEditor methodsFor: 'menu' stamp: 'nk 6/22/2004 18:34'! makeLoopedSampledSound | data end snd basePitch | data := graph data. snd := (loopEnd = 0 or: [loopLength = 0]) ifTrue: ["save as unlooped" basePitch := perceivedFrequency = 0 ifTrue: [100.0] ifFalse: [perceivedFrequency]. LoopedSampledSound new unloopedSamples: data pitch: basePitch samplingRate: samplingRate] ifFalse: [end := (loopEnd min: data size) max: 1. basePitch := samplingRate * loopCycles / loopLength. LoopedSampledSound new samples: data loopEnd: end loopLength: end pitch: basePitch samplingRate: samplingRate]. snd addReleaseEnvelope. ^snd! !