'From Squeak3.8-Nihongo of 25 February 2005 [latest update: #2] on 24 February 2005 at 6:03:53 pm'! "Change Set: FixupAfterBigChange Date: 24 February 2005 Author: Yoshiki Ohshima Resolve the conflict and adds a few methods."! !ColorPickerMorph methodsFor: 'initialization' stamp: 'yo 2/23/2005 17:17'! initializeForPropertiesPanel "Initialize the receiver. If beModal is true, it will be a modal color picker, else not" isModal _ false. self removeAllMorphs. self setProperty: #noDraggingThisPicker toValue: true. self addMorph: ((Morph newBounds: (RevertBox translateBy: self topLeft)) color: Color transparent; setCenteredBalloonText: 'restore original color' translated). self addMorph: ((Morph newBounds: (FeedbackBox translateBy: self topLeft)) color: Color transparent; setCenteredBalloonText: 'shows selected color' translated). self addMorph: ((Morph newBounds: (TransparentBox translateBy: self topLeft)) color: Color transparent; setCenteredBalloonText: 'adjust translucency' translated). self buildChartForm. selectedColor ifNil: [selectedColor _ Color white]. sourceHand _ nil. deleteOnMouseUp _ false. updateContinuously _ true. ! ! !ColorPickerMorph methodsFor: 'initialization' stamp: 'yo 2/23/2005 17:13'! initializeModal: beModal "Initialize the receiver. If beModal is true, it will be a modal color picker, else not" isModal _ beModal. self removeAllMorphs. isModal ifFalse: [theSelectorDisplayMorph _ AlignmentMorph newRow color: Color white; borderWidth: 1; borderColor: Color red; hResizing: #shrinkWrap; vResizing: #shrinkWrap; addMorph: (StringMorph contents: 'theSelector' translated). self addMorph: theSelectorDisplayMorph. self addMorph: (SimpleButtonMorph new borderWidth: 0; label: 'x' font: nil; color: Color transparent; actionSelector: #delete; target: self; useSquareCorners; position: self topLeft - (0@3); extent: 10@12; setCenteredBalloonText: 'dismiss color picker' translated)]. self addMorph: ((Morph newBounds: (DragBox translateBy: self topLeft)) color: Color transparent; setCenteredBalloonText: 'put me somewhere' translated). self addMorph: ((Morph newBounds: (RevertBox translateBy: self topLeft)) color: Color transparent; setCenteredBalloonText: 'restore original color' translated). self addMorph: ((Morph newBounds: (FeedbackBox translateBy: self topLeft)) color: Color transparent; setCenteredBalloonText: 'shows selected color' translated). self addMorph: ((Morph newBounds: (TransparentBox translateBy: self topLeft)) color: Color transparent; setCenteredBalloonText: 'adjust translucency' translated). self buildChartForm. selectedColor ifNil: [selectedColor _ Color white]. sourceHand _ nil. deleteOnMouseUp _ false. updateContinuously _ true. ! ! !EToyProjectRenamerMorph methodsFor: 'as yet unclassified' stamp: 'yo 2/23/2005 17:25'! fieldForProjectName | tm | tm _ self genericTextFieldNamed: 'projectname'. tm crAction: (MessageSend receiver: self selector: #doOK). tm setBalloonText: 'Pick a name 24 characters or less and avoid the following characters: : < > | / \ ? * " .' translated. ^tm ! ! !EToyProjectDetailsMorph methodsFor: 'as yet unclassified' stamp: 'yo 2/23/2005 17:24'! expandButton ^self buttonNamed: 'More' translated action: #doExpand color: self buttonColor help: 'Show more info on this project.' translated. ! ! !JoystickMorph methodsFor: 'menu' stamp: 'yo 2/24/2005 17:44'! chooseJoystickNumber "Allow the user to select a joystick number" | result aNumber str | str := self lastRealJoystickIndex asString. result := FillInTheBlank request: ('Joystick device number (currently {1})' translated format: {str}) initialAnswer: str. [aNumber := result asNumber] on: Error do: [:err | ^Beeper beep]. (aNumber > 0 and: [aNumber <= 32]) ifFalse: ["???" ^Beeper beep]. realJoystickIndex := aNumber. self setProperty: #lastRealJoystickIndex toValue: aNumber. self startStepping! ! !Scanner class methodsFor: 'testing' stamp: 'yo 2/24/2005 12:18'! isLiteralSymbol: aSymbol "Test whether a symbol can be stored as # followed by its characters. Symbols created internally with asSymbol may not have this property, e.g. '3' asSymbol." | i ascii type | i _ aSymbol size. i = 0 ifTrue: [^ false]. i = 1 ifTrue: [('$''"()#0123456789' includes: (aSymbol at: 1)) ifTrue: [^ false] ifFalse: [^ true]]. ascii _ (aSymbol at: 1) asciiValue. "TypeTable should have been origined at 0 rather than 1 ..." ascii = 0 ifTrue: [^ false]. type _ TypeTable at: ascii. (type == #xColon or: [type == #verticalBar or: [type == #xBinary]]) ifTrue: [ i = 1 ifTrue: [^ true] ifFalse: [^ false] ]. type == #xLetter ifTrue: [[i > 1] whileTrue: [ascii _ (aSymbol at: i) asciiValue. ascii = 0 ifTrue: [^ false]. type _ TypeTable at: ascii. (type == #xLetter or: [type == #xDigit or: [type == #xColon]]) ifFalse: [^ false]. i _ i - 1]. ^ true]. ^ false! ! !StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'yo 2/24/2005 15:45'! maxWidth ^ (fontArray at: 1) maxWidth. ! ! !SystemDictionary methodsFor: 'housekeeping' stamp: 'yo 2/24/2005 18:00'! condenseSources "Move all the changes onto a compacted sources file." "Smalltalk condenseSources" | f classCount dir newVersionString | Utilities fixUpProblemsWithAllCategory. "The above removes any concrete, spurious '-- all --' categories, which mess up the process." dir _ FileDirectory default. newVersionString _ FillInTheBlank request: 'Please designate the version for the new source code file...' initialAnswer: SourceFileVersionString. newVersionString ifNil: [^ self]. newVersionString = SourceFileVersionString ifTrue: [^ self error: 'The new source file must not be the same as the old.']. SourceFileVersionString _ newVersionString. "Write all sources with fileIndex 1" f _ FileStream newFileNamed: SmalltalkImage current sourcesName. f header; timeStamp. 'Condensing Sources File...' displayProgressAt: Sensor cursorPoint from: 0 to: Smalltalk classNames size during: [:bar | classCount _ 0. Smalltalk allClassesDo: [:class | bar value: (classCount _ classCount + 1). class fileOutOn: f moveSource: true toFile: 1]]. f trailer; close. "Make a new empty changes file" SmalltalkImage current closeSourceFiles. dir rename: SmalltalkImage current changesName toBe: SmalltalkImage current changesName , '.old'. (FileStream newFileNamed: SmalltalkImage current changesName) header; timeStamp; close. SmalltalkImage current lastQuitLogPosition: 0. self setMacFileInfoOn: SmalltalkImage current changesName. self setMacFileInfoOn: SmalltalkImage current sourcesName. SmalltalkImage current openSourceFiles. self inform: 'Source files have been rewritten!! Check that all is well, and then save/quit.'! ! !SystemDictionary methodsFor: 'housekeeping' stamp: 'yo 2/24/2005 18:01'! reconstructChanges "Move all the changes and its histories onto another sources file." "Smalltalk reconstructChanges" | f oldChanges classCount | f _ FileStream fileNamed: 'ST80.temp'. f header; timeStamp. 'Condensing Changes File...' displayProgressAt: Sensor cursorPoint from: 0 to: Smalltalk classNames size during: [:bar | classCount _ 0. Smalltalk allClassesDo: [:class | bar value: (classCount _ classCount + 1). class moveChangesWithVersionsTo: f. class putClassCommentToCondensedChangesFile: f. class class moveChangesWithVersionsTo: f]]. SmalltalkImage current lastQuitLogPosition: f position. f trailer; close. oldChanges _ SourceFiles at: 2. oldChanges close. FileDirectory default deleteFileNamed: oldChanges name , '.old'; rename: oldChanges name toBe: oldChanges name , '.old'; rename: f name toBe: oldChanges name. self setMacFileInfoOn: oldChanges name. SourceFiles at: 2 put: (FileStream oldFileNamed: oldChanges name)! ! !SystemDictionary methodsFor: 'housekeeping' stamp: 'yo 2/24/2005 18:01'! reformatChangesToUTF8 "Smalltalk reformatChangesToUTF8" | f oldChanges classCount | f _ FileStream fileNamed: 'ST80.temp'. f converter: (UTF8TextConverter new). f header; timeStamp. 'Condensing Changes File...' displayProgressAt: Sensor cursorPoint from: 0 to: Smalltalk classNames size during: [:bar | classCount _ 0. Smalltalk allClassesDo: [:class | bar value: (classCount _ classCount + 1). class moveChangesTo: f. class putClassCommentToCondensedChangesFile: f. class class moveChangesTo: f]]. SmalltalkImage current lastQuitLogPosition: f position. f trailer; close. oldChanges _ SourceFiles at: 2. oldChanges close. FileDirectory default deleteFileNamed: oldChanges name , '.old'; rename: oldChanges name toBe: oldChanges name , '.old'; rename: f name toBe: oldChanges name. self setMacFileInfoOn: oldChanges name. SourceFiles at: 2 put: (FileStream oldFileNamed: oldChanges name). MultiByteFileStream codeConverterClass: UTF8TextConverter. (SourceFiles at: 2) converter: (UTF8TextConverter new). ! ! !SystemDictionary methodsFor: 'toDeprecate' stamp: 'yo 2/24/2005 18:00'! lastQuitLogPosition self deprecated: 'Use SmalltalkImage current lastQuitLogPosition'. ^ SmalltalkImage current lastQuitLogPosition. ! !