'From etoys4.0 of 9 October 2008 [latest update: #2280] on 10 September 2009 at 1:35 pm'! "Change Set: ProjectDAV3-yo Date: 9 September 2009 Author: Yoshiki Ohshima Better error recovery. The save and load dialogs now have login button and current user's name. The apperance is slightly modified based on SQ-269."! AlignmentMorphBob1 subclass: #EtoyDAVLoginMorph instanceVariableNames: 'theName theNameMorph thePassword thePasswordMorph actionBlock cancelBlock' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Experimental'! FileList subclass: #FileList2 instanceVariableNames: 'showDirsInFileList currentDirectorySelected fileSelectionBlock dirSelectionBlock optionalButtonSpecs modalView directoryChangeBlock ok triedLogin loginButton loginField ' classVariableNames: '' poolDictionaries: '' category: 'Tools-FileList'! Object subclass: #Utilities instanceVariableNames: '' classVariableNames: 'AuthorInitials AuthorName CommonRequestStrings LastStats LoggedIn RecentSubmissions ScrapsBook UpdateDownloader UpdateUrlLists' poolDictionaries: '' category: 'System-Support'! !DAVClient methodsFor: 'public protocol' stamp: 'yo 9/9/2009 01:22'! allLastResponseCodeFrom: aString "'HTTP/1.1 405 Method Not Allowed' copyFrom: 10 to: 12" | c xml | self multistatus ifTrue: [ c := OrderedCollection new. xml := (XMLDOMParser parseDocumentFrom: aString readStream useNamespaces: true) . c := OrderedCollection new. xml withAllElementsDo: [:e | (e name asLowercase endsWith: 'd:status') ifTrue: [c add: e contents first asString]]. ^ c collect: [:s | s copyFrom: 10 to: 12]] ifFalse: [ ^ Array with: (self lastResponse copyFrom: 10 to: 12)]. ! ! !DAVClient methodsFor: 'accessing' stamp: 'yo 9/9/2009 01:23'! multistatus ^ multistatus ! ! !DAVClient methodsFor: 'private protocol' stamp: 'yo 9/9/2009 00:36'! method: method header: aDictionary body: aStringOrByteArray "(self openUrl: 'http://localhost:8080/svn/' asUrl) method: 'GET' header: Dictionary new body: ''" | body | self askNamePasswordIfNecessary. [self sendRequest: method header: aDictionary body: aStringOrByteArray. body := self receiveResponse. self isRetryNeeded] whileTrue. ^ body! ! !DAVClient methodsFor: 'private' stamp: 'yo 9/9/2009 01:23'! lastResponse: aString lastResponse _ aString. multistatus := (lastResponse asLowercase endsWith: 'multistatus') or: [lastResponse asLowercase endsWith:'multi-status']. ! ! !DAVClient methodsFor: 'as yet unclassified' stamp: 'yo 9/9/2009 01:23'! initialize super initialize. multistatus := false. ! ! !DAVServerDirectory methodsFor: 'property access' stamp: 'yo 9/9/2009 01:23'! privateEntries | location aUrl | location := 'http://' , self server , '/' , self directory , '/'. aUrl := location asUrl. self setUserAndPassIn: aUrl. ^ self privateEntriesFor: aUrl. ! ! !DAVServerDirectory methodsFor: 'property access' stamp: 'yo 9/9/2009 01:39'! privateEntriesFor: aUrl | ret | client := DAVClient openUrl: aUrl. ret := [client propFind: #('getlastmodified' 'getcontentlength' 'resourcetype' ) depth: 1 label: nil] on: Error do: [:ex | client close. (ex isKindOf: LoginFailedException) ifTrue: [ex outer]. '']. client multistatus ifTrue: [ (client allLastResponseCodeFrom: ret) do: [:code | code first = $2 ifFalse: [(LoginFailedException protocolInstance: client) signal]]]. ^ ret ifNotEmpty: [self parseDirectoryEntries: ret readStream] ifEmpty: [#()]! ! !DAVMultiUserServerDirectory methodsFor: 'as yet unclassified' stamp: 'yo 9/10/2009 08:42'! createPersonalDirectory: aString aString ifNil: [^ self]. directory := origDirectory, '/', 'public/accounts/'. altURL := server, directory. self createDirectory: aString. ! ! !EtoyDAVLoginMorph methodsFor: 'actions' stamp: 'yo 9/9/2009 01:54'! doCancel self delete. cancelBlock ifNotNil:[cancelBlock value].! ! !EtoyDAVLoginMorph methodsFor: 'actions' stamp: 'yo 9/9/2009 02:35'! doOK | proposed proposedPass | proposed _ theNameMorph contents string. proposed isEmpty ifTrue: [^self inform: 'Please enter your login name' translated]. proposed size > 24 ifTrue: [^self inform: 'Please make the name 24 characters or less' translated]. (Project isBadNameForStoring: proposed) ifTrue: [ ^self inform: 'Please remove any funny characters' translated ]. proposedPass := thePasswordMorph contents string. (actionBlock value: proposed value: proposedPass) ifTrue:[self delete].! ! !EtoyDAVLoginMorph methodsFor: 'actions' stamp: 'yo 9/10/2009 11:28'! launchBrowser self beep. "ScratchPlugin primOpenURL: 'http://squeakland.org/accountSave'."! ! !EtoyDAVLoginMorph methodsFor: 'building' stamp: 'yo 9/10/2009 13:30'! buttonColor ^ self defaultColor! ! !EtoyDAVLoginMorph methodsFor: 'building' stamp: 'yo 9/9/2009 01:54'! buttonNamed: aString action: aSymbol color: aColor help: helpString | f col | f _ SimpleButtonMorph new target: self; label: aString font: self myFont; color: aColor; actionSelector: aSymbol; setBalloonText: helpString. col _ (self inAColumn: {f}) hResizing: #spaceFill. ^col! ! !EtoyDAVLoginMorph methodsFor: 'building' stamp: 'yo 9/9/2009 01:54'! cancelButton ^self buttonNamed: 'Cancel' action: #doCancel color: self buttonColor help: 'Cancel this login operation.'! ! !EtoyDAVLoginMorph methodsFor: 'building' stamp: 'yo 9/9/2009 01:54'! myFont ^ Preferences standardEToysFont! ! !EtoyDAVLoginMorph methodsFor: 'building' stamp: 'yo 9/9/2009 01:54'! okButton ^self buttonNamed: 'OK' action: #doOK color: self buttonColor help: 'Login into Squeak'! ! !EtoyDAVLoginMorph methodsFor: 'initialization' stamp: 'yo 9/10/2009 13:31'! defaultBorderColor "answer the default border color/fill style for the receiver" ^ Color fromString: '#ECE8CC'! ! !EtoyDAVLoginMorph methodsFor: 'initialization' stamp: 'yo 9/9/2009 01:54'! defaultBorderWidth "answer the default border width for the receiver" ^ 8! ! !EtoyDAVLoginMorph methodsFor: 'initialization' stamp: 'yo 9/10/2009 13:29'! defaultColor ^ (Color fromString: '#ECE8CC') muchLighter! ! !EtoyDAVLoginMorph methodsFor: 'initialization' stamp: 'yo 9/10/2009 11:29'! initialize "initialize the state of the receiver" super initialize. "" self vResizing: #shrinkWrap; hResizing: #shrinkWrap; layoutInset: 4; beSticky; rebuild. self setProperty: #morphicLayerNumber toValue: 10.! ! !EtoyDAVLoginMorph methodsFor: 'initialization' stamp: 'yo 9/9/2009 01:54'! openInWorld: aWorld super openInWorld: aWorld. aWorld primaryHand newKeyboardFocus: theNameMorph.! ! !EtoyDAVLoginMorph methodsFor: 'initialize' stamp: 'yo 9/9/2009 01:54'! name: aString actionBlock: aBlock cancelBlock: altBlock theName _ aString. actionBlock _ aBlock. cancelBlock _ altBlock. theNameMorph contentsWrapped: theName. theNameMorph editor selectAll.! ! !EtoyDAVLoginMorph methodsFor: 'initialize' stamp: 'yo 9/10/2009 13:27'! rebuild | title link | self removeAllMorphs. title := StringMorph contents: 'Login to Squeakland' translated font: self myFont. title lock. link := StringMorph contents: 'create account' translated font: Preferences standardListFont emphasis: 4. link color: Color blue. link beSticky. link on: #click send: #launchBrowser to: self. self addARow: { title. self newSpacer: Color transparent. link}. self addARow: { (StringMorph contents:'') lock }. (self addARow: { (StringMorph contents: 'Username:' translated font: self myFont) lock. Morph new extent: 15@0; color: Color transparent. self newSpacer: Color transparent. (theNameMorph _ TextMorph new beAllFont: self myFont; crAction: (MessageSend receiver: self selector: #doOK); extent: 250@20; borderStyle: (InsetBorder new color: Color black; width: 2); contentsWrapped: 'the old name' ). }) color: self defaultColor; borderWidth: 0. self addARow: { (StringMorph contents:'') lock }. (self addARow: { (StringMorph contents: 'Password:' translated font: self myFont) lock. Morph new extent: 15@0; color: Color transparent. self newSpacer: Color transparent. (thePasswordMorph _ TextMorph new beAllFont: (FixedFaceFont new passwordFont baseFont: self myFont copy); crAction: (MessageSend receiver: self selector: #doOK); extent: 250@20; borderStyle: (InsetBorder new color: Color black; width: 2); contentsWrapped: '' ). }) color: self defaultColor. self addARow: { (StringMorph contents:'') lock }. self addARow: { self newSpacer: Color transparent. self okButton hResizing: #rigid. Morph new extent: 30@0; color: Color transparent. self cancelButton hResizing: #rigid. }. ! ! !EtoyDAVLoginMorph methodsFor: 'private' stamp: 'yo 9/10/2009 11:18'! newSpacer: aColor "Answer a space-filling instance of me of the given color." ^ Morph new hResizing: #spaceFill; vResizing: #spaceFill; layoutInset: 0; borderWidth: 0; extent: 1@1; color: aColor. ! ! !EtoyDAVLoginMorph class methodsFor: 'instance creation' stamp: 'yo 9/9/2009 10:32'! loginAndDo: aBlock ifCanceled: cancelBlock "EtoyDAVLoginMorph loginAndDo:[:n :p | true] ifCanceled:[]" | me | (me _ self new) name: '' actionBlock: aBlock cancelBlock: cancelBlock; fullBounds; position: Display extent - me extent // 2. me position: me position + (0@40). ActiveWorld addMorphInLayer: me! ! !FileList2 methodsFor: 'initialize-release' stamp: 'yo 9/9/2009 11:54'! initialize showDirsInFileList _ false. fileSelectionBlock _ [ :entry :myPattern | entry isDirectory ifTrue: [ showDirsInFileList ] ifFalse: [ myPattern = '*' or: [myPattern match: entry name] ] ] fixTemps. dirSelectionBlock _ [ :dirName | true]. ! ! !FileList2 methodsFor: 'private' stamp: 'yo 9/9/2009 03:27'! directoryNamesFor: item "item may be file directory or server directory" | entries | entries _ [item directoryNames] on: LoginFailedException do: [:ex | self inform: 'Login failed.' translated. ^ #()]. dirSelectionBlock ifNotNil:[entries _ entries select: dirSelectionBlock]. ^entries! ! !FileList2 methodsFor: 'private' stamp: 'yo 9/9/2009 02:37'! loginButton ^ loginButton ! ! !FileList2 methodsFor: 'private' stamp: 'yo 9/9/2009 02:37'! loginButton: aButton loginButton := aButton. ! ! !FileList2 methodsFor: 'private' stamp: 'yo 9/9/2009 03:13'! loginField ^ loginField! ! !FileList2 methodsFor: 'private' stamp: 'yo 9/10/2009 09:06'! loginHit | s failed ret | s := ServerDirectory servers at: 'My Squeakland' ifAbsent: [^ false]. failed := [Utilities loggedIn: false. s user: nil]. ret := true. EtoyDAVLoginMorph loginAndDo: [:n :p | s ifNotNil: [ s user: n. s password: p. [s copy createPersonalDirectory: n] on: ProtocolClientError do: [:ex | "either directory already exists or could not create. Here, it is just eaten as the following test will tell us whether it can be read."]. [s entries] on: LoginFailedException do: [:ex | failed value. self inform: 'Login failed.'. ret := false]. ret ifTrue: [Utilities authorName: n. Utilities loggedIn: true]]. self updateLoginButtonAppearance. Utilities loggedIn ifTrue: [ self directory: directory. brevityState := #FileList. "self addPath: path." self changed: #fileList. self changed: #contents. self changed: #currentDirectorySelected]. true. ] ifCanceled: failed. ! ! !FileList2 methodsFor: 'private' stamp: 'yo 9/9/2009 03:03'! logoutHit | s | s := ServerDirectory servers at: 'My Squeakland' ifAbsent: [^ false]. Utilities loggedIn: false. s user: nil. self updateLoginButtonAppearance ! ! !FileList2 methodsFor: 'private' stamp: 'yo 9/9/2009 10:48'! setSelectedDirectoryTo: aFileDirectoryWrapper currentDirectorySelected _ aFileDirectoryWrapper. [self directory: aFileDirectoryWrapper withoutListWrapper] on: LoginFailedException do: [:ex | self loginHit. ^ self]. brevityState := #FileList. "self addPath: path." self changed: #fileList. self changed: #contents. self changed: #currentDirectorySelected.! ! !FileList2 methodsFor: 'private' stamp: 'yo 9/9/2009 10:30'! updateLoginButtonAppearance | old oldField | old := loginButton. oldField := loginField. loginField := Morph new color: Color white. loginField borderWidth: 2. loginField borderColor: Color green muchLighter. loginField lock. loginField width: 150. loginField height: 30. loginField clipSubmorphs: true. Utilities loggedIn ifTrue: [ loginButton := self class buildButtonText: 'Logout' translated balloonText: nil receiver: self selector: #logoutHit. loginButton color: ScriptingSystem baseColor. loginField addMorphCentered: (StringMorph contents: (Utilities authorNamePerSe ifNil: [' ']) font: Preferences standardEToysButtonFont)] ifFalse: [ loginButton := self class buildButtonText: 'Login' translated balloonText: nil receiver: self selector: #loginHit. loginButton color: ScriptingSystem baseColor. loginField addMorphCentered: (StringMorph contents: ' ' font: Preferences standardEToysButtonFont)]. loginButton setNamePropertyTo: 'login'. loginButton width: 150. old ifNotNil: [ old owner addMorph: loginButton inFrontOf: old. old delete]. oldField ifNotNil: [ oldField owner addMorph: loginField inFrontOf: oldField. oldField delete]. ^ loginButton. ! ! !FileList2 class methodsFor: 'blue ui' stamp: 'yo 9/9/2009 03:03'! buildLoadButtons: window fileList: aFileList reallyLoad: aBoolean | aRow okButton cancelButton | okButton := self buildButtonText: 'OK' translated balloonText: nil receiver: aFileList selector: (aBoolean ifTrue: [#okHitForProjectLoader] ifFalse: [#okHit]). okButton width: 150. cancelButton := self buildButtonText: 'Cancel' translated balloonText: nil receiver: aFileList selector: #cancelHit. cancelButton width: 150. aFileList updateLoginButtonAppearance. aRow := window addARow: {aFileList loginField. aFileList loginButton. okButton. cancelButton}. aRow color: ScriptingSystem paneColor. aRow listCentering: #bottomRight. aRow layoutInset: 3 @ 3. aRow cellInset: 6 @ 3. ^ aRow! ! !FileList2 class methodsFor: 'blue ui' stamp: 'yo 9/9/2009 15:09'! buildSaveButtons: window fileList: aFileList | buttonData buttons aRow | buttonData := Preferences enableLocalSave ifTrue: [#(#('Save' #okHit 'Save in the place specified above, and in the Squeaklets folder on your local disk') #('Save on local disk only' #saveLocalOnlyHit 'saves in the Squeaklets folder') #('Cancel' #cancelHit 'return without saving') ) translatedNoop] ifFalse: [#(#('Save' #okHit 'Save in the place specified above, and in the Squeaklets folder on your local disk') #('Cancel' #cancelHit 'return without saving') ) translatedNoop]. buttons := buttonData collect: [:each | self buildButtonText: each first translated balloonText: each third translated receiver: aFileList selector: each second]. aFileList updateLoginButtonAppearance. buttons := {aFileList loginField. aFileList loginButton. Morph new color: Color transparent; width: 50}, buttons. aRow := window addARow: buttons. aRow color: ScriptingSystem paneColor. aRow listCentering: #bottomRight. aRow layoutInset: 3 @ 3. aRow cellInset: 6 @ 3. ^ aRow! ! !Project methodsFor: 'file in/out' stamp: 'yo 9/9/2009 03:28'! storeOnServerInnards "Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded." | resp newName primaryServerDirectory serverVersionPair localDirectory localVersionPair myVersionNumber warning maxNumber suppliedPassword oldResourceUrl priorWorld myDepth | self assureIntegerVersion. "Find out what version" primaryServerDirectory _ self primaryServerIfNil: [ (primaryServerDirectory _ self findAFolderToStoreProjectIn) ifNil: [^self]. oldResourceUrl _ self resourceUrl. primaryServerDirectory == #localOnly ifTrue: [ self storeNewPrimaryURL: FileDirectory default url. nil ] ifFalse: [ self storeNewPrimaryURL: primaryServerDirectory downloadUrl. primaryServerDirectory ]. ]. localDirectory _ self squeakletDirectory. [serverVersionPair _ self class mostRecent: self name onServer: primaryServerDirectory] on: LoginFailedException do: [:ex | primaryServerDirectory user: nil.^ self inform: 'Login failed.']. localVersionPair _ self class mostRecent: self name onServer: localDirectory. maxNumber _ myVersionNumber _ self currentVersionNumber. ProgressNotification signal: '2:versionsDetected'. warning _ ''. myVersionNumber < serverVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) on the server' translated. maxNumber _ maxNumber max: serverVersionPair second. ]. myVersionNumber < localVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) in the local directory' translated. maxNumber _ maxNumber max: localVersionPair second. ]. "8 Nov 2000 - only check on the first attempt to publish" myVersionNumber = 0 ifTrue: [ warning isEmpty ifFalse: [ myVersionNumber = 0 ifTrue: [ warning _ warning,'\THIS PROJECT HAS NEVER BEEN SAVED' translated. ]. warning _ 'WARNING' translated, '\Project: ' translated, self name,warning. resp _ (PopUpMenu labels: 'Store anyway\Cancel' translated withCRs) startUpWithCaption: (warning, '\Please cancel, rename this project, and see what is there.' translated) withCRs. resp ~= 1 ifTrue: [^ nil] ]. ]. version _ self bumpVersion: maxNumber. oldResourceUrl ifNotNil: [self resourceManager adjustToNewServer: self resourceUrl from: oldResourceUrl]. "write locally - now zipped automatically" Display isVirtualScreen ifTrue: [ myDepth _ displayDepth. displayDepth _ OLPCVirtualScreen preferredScreenDepth. ]. newName _ self versionedFileName. lastSavedAtSeconds _ Time totalSeconds. priorWorld _ ActiveWorld. self exportSegmentFileName: newName directory: localDirectory withoutInteraction: false. ActiveWorld _ priorWorld. (localDirectory readOnlyFileNamed: newName) setFileTypeToObject; close. Display isVirtualScreen ifTrue: [ displayDepth _ myDepth. ]. ProgressNotification signal: '4:localSaveComplete'. "3 is deep in export logic" primaryServerDirectory ifNotNil: [ suppliedPassword _ ''. Preferences passwordsOnPublish ifTrue: [ suppliedPassword _ FillInTheBlank requestPassword: 'Project password' translated ]. [ primaryServerDirectory writeProject: self inFileNamed: newName asFileName fromDirectory: localDirectory. ] on: ProjectPasswordNotification do: [ :ex | ex resume: (suppliedPassword ifNil: ['']) ]. ]. ProgressNotification signal: '9999 save complete'. "Later, store with same name on secondary servers. Still can be race conditions. All machines will go through the server list in the same order." "2 to: servers size do: [:aServer | aServer putFile: local named: newName]." ! ! !ReleaseBuilderSqueakland methodsFor: 'squeakland' stamp: 'yo 9/9/2009 03:36'! setupServerDirectoryForSqueakland | d | Utilities authorName: nil. d _ DAVMultiUserServerDirectory on: 'http://squeakland.org/webdav/'. d altUrl: 'http://squeakland.org/webdav/'. d moniker: 'My Squeakland'. d acceptsUploads: true. d useDefaultAccount: true. d origDirectory: '/webdav'. d setupSelector: #setupPersonalDirectory:. ServerDirectory inImageServers at: 'My Squeakland' put: d. d _ DAVMultiUserServerDirectory on: 'http://squeakland.org/webdav/'. d altUrl: 'http://squeakland.org/webdav/'. d moniker: 'Squeakland Showcase'. d user: 'etoys'. d useDefaultAccount: true. d acceptsUploads: false. d instVarNamed: 'passwordHolder' put: 'kaeuqs'. ServerDirectory inImageServers at: 'Squeakland Showcase' put: d. Utilities loggedIn: false. ! ! !String methodsFor: 'password compatibility' stamp: 'yo 9/9/2009 10:31'! passwordFor: aServerDir ^ self. ! ! !Utilities class methodsFor: 'identification' stamp: 'yo 9/9/2009 02:18'! loggedIn ^ LoggedIn ! ! !Utilities class methodsFor: 'identification' stamp: 'yo 9/9/2009 02:16'! loggedIn: aBoolean LoggedIn := aBoolean. ! ! !XMLNode methodsFor: 'enumerating' stamp: 'yo 9/9/2009 01:23'! withAllElementsDo: aBlock aBlock value: self. ! ! !XMLNodeWithElements methodsFor: 'enumerating' stamp: 'yo 9/9/2009 01:23'! withAllElementsDo: aBlock aBlock value: self. elements ifNotNil: [ self elements do: [:each | each withAllElementsDo: aBlock]]! ! !String reorganize! ('accessing' byteAt: byteAt:put: byteSize do:toFieldNumber: endsWithDigit findAnySubStr:startingAt: findBetweenSubStrs: findCloseParenthesisFor: findDelimiters:startingAt: findLastOccuranceOfString:startingAt: findLastOccurrenceOfString:startingAt: findString: findString:startingAt: findString:startingAt:caseSensitive: findTokens: findTokens:includes: findTokens:keep: findWordStart:startingAt: includesSubString: includesSubstring:caseSensitive: indexOfAnyOf: indexOfAnyOf:ifAbsent: indexOfAnyOf:startingAt: indexOfAnyOf:startingAt:ifAbsent: indexOfSubCollection: indexOfSubCollection:startingAt:ifAbsent: indexOf: indexOf:startingAt: indexOf:startingAt:ifAbsent: lastIndexOfPKSignature: leadingCharRunLengthAt: lineCorrespondingToIndex: lineCount lineNumber: linesDo: skipAnySubStr:startingAt: skipDelimiters:startingAt: startsWithDigit tabDelimitedFieldsDo:) ('arithmetic' * + - / // \\) ('comparing' alike: beginsWith: caseInsensitiveLessOrEqual: caseSensitiveLessOrEqual: charactersExactlyMatching: compare: compare:caseSensitive: compare:with:collated: crc16 endsWithAnyOf: endsWith: hash hashMappedBy: howManyMatch: match: sameAs: startingAt:match:startingAt: < <= = > >=) ('converting' adaptToCollection:andSend: adaptToNumber:andSend: adaptToPoint:andSend: adaptToString:andSend: asByteArray asByteString asCharacter asDate asDateAndTime asDefaultDecodedString asDisplayText asDuration asFileName asFourCode asHex asHtml asIdentifier: asInteger asIntegerIfAllDigits asIRCLowercase askIfAddStyle:req: asLegalSelector asLowercase asLowercaseAlphabetic asNumber asOctetString asPacked asParagraph asSignedInteger asSmalltalkComment asSqueakPathName asString asStringOrText asSymbol asText asTime asTimeStamp asUnHtml asUnsignedInteger asUppercase asUrl asUrlRelativeTo: asVmPathName asWideString capitalized composeAccents compressWithTable: contractTo: convertFromEncoding: convertFromSuperSwikiServerString convertFromWithConverter: convertToEncoding: convertToSuperSwikiServerString convertToSystemString convertToWithConverter: correctAgainstDictionary:continuedFrom: correctAgainst: correctAgainst:continuedFrom: encodeForHTTP encodeForHTTPWithTextEncoding: encodeForHTTPWithTextEncoding:conditionBlock: findSelector fromCamelCase initialIntegerOrNil keywords numericSuffix onlyLetters romanNumber sansPeriodSuffix splitInteger squeakToUtf8 stemAndNumericSuffix subStrings subStrings: substrings surroundedBySingleQuotes toCamelCase translateFrom:to:table: translateToLowercase translateToUppercase translateWith: truncateTo: truncateWithElipsisTo: unescapePercents unescapePercentsWithTextEncoding: unparenthetically unzipped utf8ToSqueak withBlanksCondensed withBlanksTrimmed withFirstCharacterDownshifted withNoLineLongerThan: withoutLeadingDigits withoutTrailingBlanks withoutTrailingDigits withSeparatorsCompacted) ('copying' copy copyReplaceTokens:with: deepCopy padded:to:with: shallowCopy) ('displaying' displayAt: displayOn: displayOn:at: displayOn:at:textColor: displayProgressAt:from:to:during:) ('encoding' getInteger32: putInteger32:at: writeLeadingCharRunsOn:) ('filter streaming' byteEncode: putOn:) ('formatting' format: withCRs) ('internet' decodeMimeHeader decodeQuotedPrintable isoToSqueak isoToUtf8 macToSqueak squeakToIso squeakToMac utf8ToIso withInternetLineEndings withoutQuoting withSqueakLineEndings) ('paragraph support' indentationIfBlank:) ('printing' basicType encodeDoublingQuoteOn: isLiteral printOn: storeOn: stringRepresentation) ('system primitives' endsWithAColon findSubstring:in:startingAt:matchTable: numArgs) ('testing' hasContentsInExplorer includesUnifiedCharacter isAllDigits isAllSeparators isAsciiString isByteString isOctetString isReallyString isString isWideString lastSpacePosition) ('translating' literalStringsDo: translated translatedIfCorresponds translatedNoop translatedTo: translatedTo:inDomain:) ('user interface' asExplorerString openInWorkspaceWithTitle:) ('*eToys-*Morphic' newTileMorphRepresentative) ('*Morphic' asMorph asStringMorph) ('*MorphicExtras-*morphic-Postscript Canvases' asPostscript) ('*Morphic-converting' openAsMorph) ('*monticello') ('*network-uri') ('*packageinfo-base' escapeEntities) ('*services-base') ('*versionnumber' asVersion) ('private' correctAgainstEnumerator:continuedFrom: evaluateExpression:parameters: getEnclosedExpressionFrom: replaceFrom:to:with:startingAt: stringhash) ('pango' asPangoAttributes) ('Camp Smalltalk' sunitAsSymbol sunitMatch: sunitSubStrings) ('*network-mime' asMIMEType) ('*connectors-converting' splitOnCapBoundaries) ('*DBus-Core' dbusCoerceTo: dbusType) ('*network-HTML' replaceHtmlCharRefs) ('*xml-parser' applyLanguageInfomation:) ('*FSM-events' eventType) ('*connectors-comparing' beginsWith2:) ('*siss-converting' sissEscape sissUnescape) ('*GStreamer-Base' nullTerminated) ('password compatibility' passwordFor:) ! FileList2 removeSelector: #loginButtonAppearance! FileList subclass: #FileList2 instanceVariableNames: 'showDirsInFileList currentDirectorySelected fileSelectionBlock dirSelectionBlock optionalButtonSpecs modalView directoryChangeBlock ok loginButton loginField' classVariableNames: '' poolDictionaries: '' category: 'Tools-FileList'! EtoyDAVLoginMorph removeSelector: #addARowWithSpaceFill:! EtoyDAVLoginMorph removeSelector: #inARowWithSpaceFill:! !EtoyDAVLoginMorph reorganize! ('actions' doCancel doOK launchBrowser) ('building' buttonColor buttonNamed:action:color:help: cancelButton myFont okButton) ('initialization' defaultBorderColor defaultBorderWidth defaultColor initialize openInWorld:) ('initialize' name:actionBlock:cancelBlock: rebuild) ('private' newSpacer:) ! "Postscript: Leave the line above, and replace the rest of this comment by a useful one. Executable statements should follow this comment, and should be separated by periods, with no exclamation points (!!). Be sure to put any further comments in double-quotes, like this one." ReleaseBuilderSqueakland new setupServerDirectoryForSqueakland. !