Packages November 2009

packages@lists.squeakfoundation.org

2 participants
570 discussions

The Trunk: Multilingual-dtl.67.mcz
by commits＠source.squeak.org 30 Nov '09

30 Nov '09

David T. Lewis uploaded a new version of Multilingual to project The Trunk: http://source.squeak.org/trunk/Multilingual-dtl.67.mcz ==================== Summary ==================== Name: Multilingual-dtl.67 Author: dtl Time: 29 November 2009, 9:34:12 am UUID: 674101cf-1ac8-4cc7-9e61-257bbd794434 Ancestors: Multilingual-nice.66 Use Beeper class>>beep rather than deprecated Object>>beep =============== Diff against Multilingual-nice.66 =============== Item was changed: Object subclass: #LanguageEnvironment instanceVariableNames: 'id' classVariableNames: 'ClipboardInterpreterClass Current FileNameConverterClass InputInterpreterClass KnownEnvironments SystemConverterClass' poolDictionaries: '' category: 'Multilingual-Languages'! !LanguageEnvironment commentStamp: 'bf 8/16/2009 16:52' prior: 0! The name multilingualized Squeak suggests that you can use multiple language at one time. This is true, of course, but the system still how to manage the primary language; that provides the interpretation of data going out or coming in from outside world. It also provides how to render strings, as there rendering rule could be different in one language to another, even if the code points in a string is the same. Originally, LanguageEnvironment and its subclasses only has class side methods. After merged with Diego's Babel work, it now has instance side methods. Since this historical reason, the class side and instance side are not related well. + When we talk about the interface with the outside of the Squeak world, there are three different "channels"; the keyboard input, clipboard output and input, and filename. On a not-to-uncommon system such as a Unix system localized to Japan, all of these three can have (and does have) different encodings. So we need to manage them separately. Note that the encoding in a file can be anything. While it is nice to provide a suggested guess for this 'default system file content encoding', it is not critical. - When we talk about the interface with the outside of the Squeak world, there are three different "channels"; the keyboard input, clipboard output and input, and filename. On a not-to-uncommon system such as a Unix system localized to Japan, all of these three can have (and does have) different encodings. So we need to manage them separately. Note that the encoding in a file can be anything. While it is nice to provide a suggested guess for this 'default system file content encoding', it is not critical. Rendering support is limited basic L-to-R rendering so far. But you can provide different line-wrap rule, at least. ! Item was changed: ----- Method: LanguageEditor>>loadFromFile (in category 'gui methods') ----- loadFromFile | fileName | fileName := self selectTranslationFileName. fileName isNil ifTrue: ["" + Beeper beep. - self beep. ^ self]. "" Cursor wait showWhile: [ self translator loadFromFileNamed: fileName. self changed: #translations. self changed: #untranslated]! Item was changed: ----- Method: LanguageEditor>>searchUntranslated: (in category 'gui methods') ----- searchUntranslated: aString | untranslateds results index | untranslateds := self untranslated. results := untranslateds select: [:each | '*' , aString , '*' match: each]. "" results isEmpty ifTrue: ["" self inform: 'no matches for' translated , ' ''' , aString , ''''. ^ self]. "" results size = 1 ifTrue: ["" self selectUntranslatedPhrase: results first. ^ self]. "" index := (UIManager default chooseFrom: (results collect: [:each | each copy replaceAll: Character cr with: $\]) title: 'select the untranslated phrase...' translated). "" index isZero ifTrue: ["" + Beeper beep. - self beep. ^ self]. "" self selectUntranslatedPhrase: (results at: index)! Item was changed: ----- Method: LanguageEditor>>saveToFile (in category 'gui methods') ----- saveToFile "save the translator to a file" | fileName | fileName := UIManager default request: 'file name' translated initialAnswer: translator localeID isoString , '.translation'. (fileName isNil or: [fileName isEmpty]) ifTrue: ["" + Beeper beep. - self beep. ^ self]. "" Cursor wait showWhile: [ self translator saveToFileNamed: fileName]! Item was changed: ----- Method: LanguageEditor>>searchUntranslated (in category 'gui methods') ----- searchUntranslated | search | search := UIManager default request: 'search for' translated initialAnswer: ''. (search isNil or: [search isEmpty]) ifTrue: ["" + Beeper beep. - self beep. ^ self]. "" self searchUntranslated: search! Item was changed: ----- Method: LanguageEditor>>removeTranslation (in category 'gui methods') ----- removeTranslation "remove the selected translation" | translation | self selectedTranslation isZero ifTrue: ["" + Beeper beep. - self beep. self inform: 'select the translation to remove' translated. ^ self]. "" translation := self translations at: self selectedTranslation. "" (self confirm: ('Removing "{1}". Are you sure you want to do this?' translated format: {translation})) ifFalse: [^ self]. "" self translator removeTranslationFor: translation. self changed: #translations. self changed: #untranslated.! Item was changed: ----- Method: LanguageEditor>>searchTranslation (in category 'gui methods') ----- searchTranslation | search | search := UIManager default request: 'search for' translated initialAnswer: ''. (search isNil or: [search isEmpty]) ifTrue: ["" + Beeper beep. - self beep. ^ self]. "" self searchTranslation: search! Item was changed: ----- Method: LanguageEditor>>addTranslation (in category 'gui methods') ----- addTranslation "translate a phrase" | phrase | phrase := UIManager default request: 'enter the original:' initialAnswer: ''. (phrase isNil or: [phrase = '']) ifTrue: ["" + Beeper beep. - self beep. ^ self]. "" self translatePhrase: phrase! Item was changed: ----- Method: LanguageEditor>>removeUntranslated (in category 'gui methods') ----- removeUntranslated "remove the selected untranslated phrase" | untranslated | self selectedUntranslated isZero ifTrue: ["" + Beeper beep. - self beep. self inform: 'select the untranslated phrase to remove' translated. ^ self]. "" untranslated := self untranslated at: self selectedUntranslated. "" (self confirm: ('Removing "{1}". Are you sure you want to do this?' translated format: {untranslated})) ifFalse: [^ self]. "" self translator removeUntranslated: untranslated! Item was changed: ----- Method: LanguageEditor>>translate (in category 'gui methods') ----- translate "translate a phrase" | phrase | phrase := self phraseToTranslate. "" (phrase isNil or: [phrase = '']) ifTrue: ["" + Beeper beep. - self beep. ^ self]. "" self translatePhrase: phrase! Item was changed: ----- Method: LanguageEditor>>searchTranslation: (in category 'gui methods') ----- searchTranslation: aString | translations results index | translations := self translations. results := translations select: [:each | "" ('*' , aString , '*' match: each) or: ['*' , aString , '*' match: (self translator translationFor: each)]]. "" results isEmpty ifTrue: ["" self inform: 'no matches for' translated , ' ''' , aString , ''''. ^ self]. "" results size = 1 ifTrue: ["" self selectTranslationPhrase: results first. ^ self]. "" index := (UIManager default chooseFrom: (results collect: [:each | "" (each copy replaceAll: Character cr with: $\) , ' -> ' , ((self translator translationFor: each) copy replaceAll: Character cr with: $\)]) title: 'select the translation...' translated). "" index isZero ifTrue: ["" + Beeper beep. - self beep. ^ self]. "" self selectTranslationPhrase: (results at: index)! Item was changed: ----- Method: LanguageEditor>>mergeFromFile (in category 'gui methods') ----- mergeFromFile | fileName | fileName := self selectTranslationFileName. fileName isNil ifTrue: ["" + Beeper beep. - self beep. ^ self]. "" Cursor wait showWhile: [ self translator loadFromFileNamed: fileName. self changed: #translations. self changed: #untranslated]! Item was changed: ----- Method: LanguageEditor>>translatePhrase: (in category 'gui methods') ----- translatePhrase: aString "translate aString" | translation | translation := UIManager default multiLineRequest: 'translation for: ' translated , '''' , aString , '''' centerAt: Sensor cursorPoint initialAnswer: aString answerHeight: 200. "" (translation isNil or: [translation = '']) ifTrue: ["" + Beeper beep. - self beep. ^ self]. "" self phrase: aString translation: translation! Item was changed: ----- Method: LanguageEditor>>browseMethodsWithTranslation (in category 'gui methods') ----- browseMethodsWithTranslation | translation | self selectedTranslation isZero ifTrue: ["" + Beeper beep. - self beep. self inform: 'select the translation to look for' translated. ^ self]. "" translation := self translations at: self selectedTranslation. self systemNavigation browseMethodsWithLiteral: translation! Item was changed: ----- Method: LanguageEditor>>browseMethodsWithUntranslated (in category 'gui methods') ----- browseMethodsWithUntranslated | untranslated | self selectedUntranslated isZero ifTrue: ["" + Beeper beep. - self beep. self inform: 'select the untranslated phrase to look for' translated. ^ self]. "" untranslated := self untranslated at: self selectedUntranslated. SystemNavigation default browseMethodsWithLiteral: untranslated. !

1 0

The Trunk: System-dtl.183.mcz
by commits＠source.squeak.org 30 Nov '09

30 Nov '09

David T. Lewis uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-dtl.183.mcz ==================== Summary ==================== Name: System-dtl.183 Author: dtl Time: 29 November 2009, 7:27:35 am UUID: aec8c06f-e83f-46ec-80cc-4e91f2000b4a Ancestors: System-nice.182 Remove all remaining explicit MVC and Morphic dependencies (hopefully) from class Project. =============== Diff against System-nice.182 =============== Item was changed: ----- Method: Project>>loadFromServer: (in category 'file in/out') ----- loadFromServer: newerAutomatically "If a newer version of me is on the server, load it." - | pair resp server | - self assureIntegerVersion. + self subclassResponsibility! - self isCurrentProject ifTrue: ["exit, then do the command" - ^ self armsLengthCommand: #loadFromServer withDescription: 'Loading' translated - ]. - server := self tryToFindAServerWithMe ifNil: [^ nil]. - pair := self class mostRecent: self name onServer: server. - pair first ifNil: [^ self inform: ('can''t find file on server for {1}' translated format: {self name})]. - self currentVersionNumber > pair second ifTrue: [ - ^ self inform: ('That server has an older version of the project.' translated)]. - version = (Project parseProjectFileName: pair first) second ifTrue: [ - resp := (UIManager default chooseFrom: - (Array with: 'Reload anyway' translated - with: 'Cancel' translated withCRs) - title: 'The only changes are the ones you made here.' translated). - resp ~= 1 ifTrue: [^ nil] - ] ifFalse: [ - newerAutomatically ifFalse: [ - resp := (UIManager default - chooseFrom: #('Load it' 'Cancel') - title: 'A newer version exists on the server.'). - resp ~= 1 ifTrue: [^ nil] - ]. - ]. - - "let's avoid renaming the loaded change set since it will be replacing ours" - self projectParameters at: #loadingNewerVersion put: true. - - ComplexProgressIndicator new - targetMorph: nil; - historyCategory: 'project loading'; - withProgressDo: [ - ProjectLoading - installRemoteNamed: pair first - from: server - named: self name - in: parentProject - ] - ! Item was changed: ----- Method: Project>>makeThumbnail (in category 'menu messages') ----- makeThumbnail "Make a thumbnail image of this project from the Display." viewSize ifNil: [viewSize := Display extent // 8]. thumbnail := Form extent: viewSize depth: Display depth. (WarpBlt current toForm: thumbnail) sourceForm: Display; cellSize: 2; "installs a colormap" combinationRule: Form over; copyQuad: (Display boundingBox) innerCorners toRect: (0@0 extent: viewSize). + (Smalltalk at: #InternalThreadNavigationMorph) ifNotNilDo: [:tnMorph | + tnMorph cacheThumbnailFor: self]. - InternalThreadNavigationMorph cacheThumbnailFor: self. ^thumbnail ! Item was changed: ----- Method: Project>>chooseNaturalLanguage (in category 'language') ----- chooseNaturalLanguage "Put up a menu allowing the user to choose the natural language for the project" + "Project current chooseNaturalLanguage" - | aMenu availableLanguages | - aMenu := MenuMorph new defaultTarget: self. - aMenu addTitle: 'choose language' translated. - aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed. It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system. Each project has its own private language choice' translated. - Preferences noviceMode - ifFalse:[aMenu addStayUpItem]. - - availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs - asSortedCollection:[:x :y | x displayName < y displayName]. - - availableLanguages do: - [:localeID | - aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector: #switchAndInstallFontToID: argumentList: {localeID}]. - aMenu popUpInWorld + self subclassResponsibility + ! - "Project current chooseNaturalLanguage"! Item was changed: ----- Method: Project>>storeOnServerWithProgressInfoOn: (in category 'file in/out') ----- storeOnServerWithProgressInfoOn: aMorphOrNil "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." + self subclassResponsibility - ComplexProgressIndicator new - targetMorph: aMorphOrNil; - historyCategory: 'project storing'; - withProgressDo: [self storeOnServerInnards] ! Item was added: Item was changed: ----- Method: Project>>storeSegment (in category 'file in/out') ----- storeSegment "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***" + self subclassResponsibility - | is sizeHint | - (World == world) ifTrue: [^ false]. - "self inform: 'Can''t send the current world out'." - world isInMemory ifFalse: [^ false]. "already done" - world isMorph ifFalse: [ - self projectParameters at: #isMVC put: true. - ^ false]. "Only Morphic projects for now" - world ifNil: [^ false]. world presenter ifNil: [^ false]. - - Utilities emptyScrapsBook. - World checkCurrentHandForObjectToPaste. - world releaseSqueakPages. - sizeHint := self projectParameters at: #segmentSize ifAbsent: [0]. - - is := ImageSegment new copyFromRootsLocalFileFor: - (Array with: world presenter with: world) "world, and all Players" - sizeHint: sizeHint. - - is state = #tooBig ifTrue: [^ false]. - is segment size < 2000 ifTrue: ["debugging" - Transcript show: self name, ' only ', is segment size printString, - 'bytes in Segment.'; cr]. - self projectParameters at: #segmentSize put: is segment size. - is extract; writeToFile: self name. - ^ true ! Item was changed: ----- Method: Project>>exportSegmentWithChangeSet:fileName:directory: (in category 'file in/out') ----- exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it <project name>.extSeg. Whatdo we do about subProjects, especially if they are out as local image segments? Force them to come in? Player classes are included automatically." + self subclassResponsibility! - | is str ans revertSeg roots holder collector fd mgr stacks | - - "Files out a changeSet first, so that a project can contain - its own classes" - world isMorph ifFalse: [ - self projectParameters at: #isMVC put: true. - ^ false]. "Only Morphic projects for now" - world ifNil: [^ false]. world presenter ifNil: [^ false]. - - Utilities emptyScrapsBook. - world currentHand pasteBuffer: nil. "don't write the paste buffer." - world currentHand mouseOverHandler initialize. "forget about any - references here" - "Display checkCurrentHandForObjectToPaste." - Command initialize. - world clearCommandHistory. - world fullReleaseCachedState; releaseViewers. - world cleanseStepList. - world localFlapTabs size = world flapTabs size ifFalse: [ - self error: 'Still holding onto Global flaps']. - world releaseSqueakPages. - ScriptEditorMorph writingUniversalTiles: (self projectParameterAt: - #universalTiles ifAbsent: [false]). - holder := Project allProjects. "force them in to outPointers, where - DiskProxys are made" - - "Just export me, not my previous version" - revertSeg := self projectParameters at: #revertToMe ifAbsent: [nil]. - self projectParameters removeKey: #revertToMe ifAbsent: []. - - roots := OrderedCollection new. - roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail. - roots add: world activeHand. - - "; addAll: classList; addAll: (classList collect: [:cls | cls class])" - - roots := roots reject: [ :x | x isNil]. "early saves may not have - active hand or thumbnail" - - fd := aDirectory directoryNamed: self resourceDirectoryName. - fd assureExistence. - "Clean up resource references before writing out" - mgr := self resourceManager. - self resourceManager: nil. - ResourceCollector current: ResourceCollector new. - ResourceCollector current localDirectory: fd. - ResourceCollector current baseUrl: self resourceUrl. - ResourceCollector current initializeFrom: mgr. - ProgressNotification signal: '2:findingResources' extra: - '(collecting resources...)' translated. - "Must activate old world because this is run at #armsLength. - Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent - will not be captured correctly if referenced from blocks or user code." - world becomeActiveDuring:[ - is := ImageSegment new copySmartRootsExport: roots asArray. - "old way was (is := ImageSegment new - copyFromRootsForExport: roots asArray)" - ]. - self resourceManager: mgr. - collector := ResourceCollector current. - ResourceCollector current: nil. - ProgressNotification signal: '2:foundResources' extra: ''. - is state = #tooBig ifTrue: [ - collector replaceAll. - ^ false]. - - str := ''. - "considered legal to save a project that has never been entered" - (is outPointers includes: world) ifTrue: [ - str := str, '\Project''s own world is not in the segment.' translated withCRs]. - str isEmpty ifFalse: [ - ans := UIManager default chooseFrom: { - 'Do not write file' translated. - 'Write file anyway' translated. - 'Debug' translated. - } title: str. - ans = 1 ifTrue: [ - revertSeg ifNotNil: [projectParameters at: - #revertToMe put: revertSeg]. - collector replaceAll. - ^ false]. - ans = 3 ifTrue: [ - collector replaceAll. - self halt: 'Segment not written' translated]]. - stacks := is findStacks. - - is - writeForExportWithSources: aFileName - inDirectory: fd - changeSet: aChangeSetOrNil. - SecurityManager default signFile: aFileName directory: fd. - "Compress all files and update check sums" - collector forgetObsolete. - self storeResourceList: collector in: fd. - self storeHtmlPageIn: fd. - self storeManifestFileIn: fd. - self writeStackText: stacks in: fd registerIn: collector. - "local proj.005.myStack.t" - self compressFilesIn: fd to: aFileName in: aDirectory - resources: collector. - "also deletes the resource directory" - "Now update everything that we know about" - mgr updateResourcesFrom: collector. - - revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. - holder. - - collector replaceAll. - - world flapTabs do: [:ft | - (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. - is arrayOfRoots do: [:obj | - obj class == ScriptEditorMorph ifTrue: [obj unhibernate]]. - ^ true - ! Item was changed: ----- Method: Project>>storeOnServerWithProgressInfo (in category 'file in/out') ----- storeOnServerWithProgressInfo "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." + self subclassResponsibility + ! - ComplexProgressIndicator new - targetMorph: nil; - historyCategory: 'project storing'; - withProgressDo: [self storeOnServerInnards] - ! Item was changed: ----- Method: Project>>initializeProjectPreferences (in category 'project parameters') ----- initializeProjectPreferences "Initialize the project's preferences from currently-prevailing preferences that are currently being held in projects in this system" projectPreferenceFlagDictionary := Project current projectPreferenceFlagDictionary deepCopy. "Project overrides in the new project start out being the same set of overrides in the calling project" Preferences allPreferenceObjects do: "in case we missed some" [:aPreference | aPreference localToProject ifTrue: [(projectPreferenceFlagDictionary includesKey: aPreference name) ifFalse: [projectPreferenceFlagDictionary at: aPreference name put: aPreference preferenceValue]]]. - self isMorphic ifFalse: [self flapsSuppressed: true]. (Project current projectParameterAt: #disabledGlobalFlapIDs ifAbsent: [nil]) ifNotNilDo: [:idList | self projectParameterAt: #disabledGlobalFlapIDs put: idList copy] ! Item was changed: ----- Method: Project>>storeSegmentNoFile (in category 'file in/out') ----- storeSegmentNoFile "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)" + self subclassResponsibility - | is str | - (World == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." - world isInMemory ifFalse: [^ self]. "already done" - world isMorph ifFalse: [ - self projectParameters at: #isMVC put: true. - ^ self]. "Only Morphic projects for now" - world ifNil: [^ self]. world presenter ifNil: [^ self]. - - "Do this on project enter" - World flapTabs do: [:ft | ft referent adaptToWorld: World]. - "Hack to keep the Menu flap from pointing at my project" - "Preferences setPreference: #useGlobalFlaps toValue: false." - "Utilities globalFlapTabsIfAny do: - [:aFlapTab | Utilities removeFlapTab: aFlapTab keepInList: false]. - Utilities clobberFlapTabList. " - "project world deleteAllFlapArtifacts." - "self currentWorld deleteAllFlapArtifacts. " - Utilities emptyScrapsBook. - World checkCurrentHandForObjectToPaste2. - - is := ImageSegment new copyFromRootsLocalFileFor: - (Array with: world presenter with: world) "world, and all Players" - sizeHint: 0. - - is segment size < 800 ifTrue: ["debugging" - Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep]. - false ifTrue: [ - str := String streamContents: [:strm | - strm nextPutAll: 'Only a tiny part of the project got into the segment'. - strm nextPutAll: '\These are pointed to from the outside:' withCRs. - is outPointers do: [:out | - (out class == Presenter) | (out class == ScriptEditorMorph) ifTrue: [ - strm cr. out printOn: strm. - self systemNavigation - browseAllObjectReferencesTo: out - except: (Array with: is outPointers) - ifNone: [:obj | ]]. - (is arrayOfRoots includes: out class) ifTrue: [strm cr. out printOn: strm. - self systemNavigation - browseAllObjectReferencesTo: out - except: (Array with: is outPointers) - ifNone: [:obj | ]]]]. - self inform: str. - ^ is inspect]. - - is extract. - "is instVarAt: 2 put: is segment clone." "different memory" ! Item was changed: ----- Method: Project>>exportSegmentWithCatagories:classes:fileName:directory: (in category 'file in/out') ----- exportSegmentWithCatagories: catList classes: classList fileName: aFileName directory: aDirectory "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it <project name>.extSeg. What do we do about subProjects, especially if they are out as local image segments? Force them to come in? Player classes are included automatically." + self flag: #toRemove. + self subclassResponsibility - | is str ans revertSeg roots holder | - self halt. "unused" - "world == World ifTrue: [^ false]." - "self inform: 'Can''t send the current world out'." - world isMorph ifFalse: [ - self projectParameters at: #isMVC put: true. - ^ false]. "Only Morphic projects for now" - world ifNil: [^ false]. world presenter ifNil: [^ false]. - - Utilities emptyScrapsBook. - world currentHand pasteBuffer: nil. "don't write the paste buffer." - world currentHand mouseOverHandler initialize. "forget about any references here" - "Display checkCurrentHandForObjectToPaste." - Command initialize. - world clearCommandHistory. - world fullReleaseCachedState; releaseViewers. - world cleanseStepList. - world localFlapTabs size = world flapTabs size ifFalse: [ - self error: 'Still holding onto Global flaps']. - world releaseSqueakPages. - ScriptEditorMorph writingUniversalTiles: (self projectParameterAt: #universalTiles ifAbsent: [false]). - holder := Project allProjects. "force them in to outPointers, where DiskProxys are made" - - "Just export me, not my previous version" - revertSeg := self projectParameters at: #revertToMe ifAbsent: [nil]. - self projectParameters removeKey: #revertToMe ifAbsent: []. - - roots := OrderedCollection new. - roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail. - roots add: world activeHand; addAll: classList; addAll: (classList collect: [:cls | cls class]). - - roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail" - - catList do: [:sysCat | - (SystemOrganization listAtCategoryNamed: sysCat asSymbol) do: [:symb | - roots add: (Smalltalk at: symb); add: (Smalltalk at: symb) class]]. - - is := ImageSegment new copySmartRootsExport: roots asArray. - "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)" - - is state = #tooBig ifTrue: [^ false]. - - str := ''. - "considered legal to save a project that has never been entered" - (is outPointers includes: world) ifTrue: [ - str := str, '\Project''s own world is not in the segment.' withCRs]. - str isEmpty ifFalse: [ - ans := (UIManager default - chooseFrom: #('Do not write file' 'Write file anyway' 'Debug') - title: str). - ans = 1 ifTrue: [ - revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. - ^ false]. - ans = 3 ifTrue: [self halt: 'Segment not written']]. - - is writeForExportWithSources: aFileName inDirectory: aDirectory. - revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. - holder. - world flapTabs do: [:ft | - (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. - is arrayOfRoots do: [:obj | - obj class == ScriptEditorMorph ifTrue: [obj unhibernate]]. - ^ true ! Item was changed: ----- Method: Project>>validateProjectNameIfOK: (in category 'menu messages') ----- validateProjectNameIfOK: aBlock | details | details := world valueOfProperty: #ProjectDetails. details ifNotNil: ["ensure project info matches real project name" details at: 'projectname' put: self name. ]. self doWeWantToRename ifFalse: [^aBlock value]. + (Smalltalk at: #EToyProjectDetailsMorph) ifNotNilDo: [:etpdm | + etpdm + getFullInfoFor: self + ifValid: [ + World displayWorldSafely. + aBlock value. + ] fixTemps + expandedFormat: false] - EToyProjectDetailsMorph - getFullInfoFor: self - ifValid: [ - World displayWorldSafely. - aBlock value. - ] fixTemps - expandedFormat: false ! Item was removed: - ----- Method: Project>>currentStack (in category 'project parameters') ----- - currentStack - "Answer the current stack of the current project. Called basically as a bail-out when we can't find the stack in the owner chain of a morph, probably because it is on a background that is not currently installed. This method will always return a stack that is in the world, or nil if no stack is found in the world. Of course it would be nice to have multiple stacks concurrently open in the same world, but at the moment that is problematical." - - | aStack curStack | - - curStack := self projectParameterAt: #CurrentStack. - curStack ifNotNil: [curStack isInWorld ifTrue: [^ curStack]]. - - (aStack := world findA: StackMorph) ifNotNil: - [self currentStack: aStack]. - ^ aStack! Item was removed: - ----- Method: Project>>setPaletteFor: (in category 'language') ----- - setPaletteFor: aLanguageSymbol - | prototype formKey form | - prototype := PaintBoxMorph prototype. - formKey := ('offPalette' , aLanguageSymbol) asSymbol. - form := Imports default imports - at: formKey - ifAbsent: [Imports default imports - at: #offPaletteEnglish - ifAbsent: []]. - form isNil ifFalse: [prototype loadOffForm: form]. - formKey := ('pressedPalette' , aLanguageSymbol) asSymbol. - form := Imports default imports - at: formKey - ifAbsent: [Imports default imports - at: #pressedPaletteEnglish - ifAbsent: []]. - form isNil ifFalse: [prototype loadPressedForm: form]. - !

1 0

The Trunk: System-dtl.183.mcz
by commits＠source.squeak.org 30 Nov '09

30 Nov '09

1 0

The Trunk: System-dtl.183.mcz
by commits＠source.squeak.org 30 Nov '09

30 Nov '09

1 0

The Trunk: Morphic-dtl.258.mcz
by commits＠source.squeak.org 30 Nov '09

30 Nov '09

David T. Lewis uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-dtl.258.mcz ==================== Summary ==================== Name: Morphic-dtl.258 Author: dtl Time: 29 November 2009, 7:23:21 am UUID: a4165410-fe21-4742-8a12-42b2049b84bb Ancestors: Morphic-ar.257 Remove all remaining explicit MVC and Morphic dependencies (hopefully) from class Project. =============== Diff against Morphic-ar.257 =============== Item was added: + ----- Method: MorphicProject>>currentStack (in category 'project parameters') ----- + currentStack + "Answer the current stack of the current project. Called basically as a bail-out when we can't find the stack in the owner chain of a morph, probably because it is on a background that is not currently installed. This method will always return a stack that is in the world, or nil if no stack is found in the world. Of course it would be nice to have multiple stacks concurrently open in the same world, but at the moment that is problematical." + + | aStack curStack | + + curStack := self projectParameterAt: #CurrentStack. + curStack ifNotNil: [curStack isInWorld ifTrue: [^ curStack]]. + + (aStack := world findA: StackMorph) ifNotNil: + [self currentStack: aStack]. + ^ aStack! Item was added: + ----- Method: MorphicProject>>loadFromServer: (in category 'file in/out') ----- + loadFromServer: newerAutomatically + "If a newer version of me is on the server, load it." + | pair resp server | + self assureIntegerVersion. + + self isCurrentProject ifTrue: ["exit, then do the command" + ^ self armsLengthCommand: #loadFromServer withDescription: 'Loading' translated + ]. + server := self tryToFindAServerWithMe ifNil: [^ nil]. + pair := self class mostRecent: self name onServer: server. + pair first ifNil: [^ self inform: ('can''t find file on server for {1}' translated format: {self name})]. + self currentVersionNumber > pair second ifTrue: [ + ^ self inform: ('That server has an older version of the project.' translated)]. + version = (Project parseProjectFileName: pair first) second ifTrue: [ + resp := (UIManager default chooseFrom: + (Array with: 'Reload anyway' translated + with: 'Cancel' translated withCRs) + title: 'The only changes are the ones you made here.' translated). + resp ~= 1 ifTrue: [^ nil] + ] ifFalse: [ + newerAutomatically ifFalse: [ + resp := (UIManager default + chooseFrom: #('Load it' 'Cancel') + title: 'A newer version exists on the server.'). + resp ~= 1 ifTrue: [^ nil] + ]. + ]. + + "let's avoid renaming the loaded change set since it will be replacing ours" + self projectParameters at: #loadingNewerVersion put: true. + + ComplexProgressIndicator new + targetMorph: nil; + historyCategory: 'project loading'; + withProgressDo: [ + ProjectLoading + installRemoteNamed: pair first + from: server + named: self name + in: parentProject + ] + ! Item was added: + ----- Method: MorphicProject>>exportSegmentWithCatagories:classes:fileName:directory: (in category 'file in/out') ----- + exportSegmentWithCatagories: catList classes: classList fileName: aFileName directory: aDirectory + "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it <project name>.extSeg. What do we do about subProjects, especially if they are out as local image segments? Force them to come in? + Player classes are included automatically." + + | is str ans revertSeg roots holder | + self flag: #toRemove. + self halt. "unused" + "world == World ifTrue: [^ false]." + "self inform: 'Can''t send the current world out'." + world ifNil: [^ false]. world presenter ifNil: [^ false]. + + Utilities emptyScrapsBook. + world currentHand pasteBuffer: nil. "don't write the paste buffer." + world currentHand mouseOverHandler initialize. "forget about any references here" + "Display checkCurrentHandForObjectToPaste." + Command initialize. + world clearCommandHistory. + world fullReleaseCachedState; releaseViewers. + world cleanseStepList. + world localFlapTabs size = world flapTabs size ifFalse: [ + self error: 'Still holding onto Global flaps']. + world releaseSqueakPages. + ScriptEditorMorph writingUniversalTiles: (self projectParameterAt: #universalTiles ifAbsent: [false]). + holder := Project allProjects. "force them in to outPointers, where DiskProxys are made" + + "Just export me, not my previous version" + revertSeg := self projectParameters at: #revertToMe ifAbsent: [nil]. + self projectParameters removeKey: #revertToMe ifAbsent: []. + + roots := OrderedCollection new. + roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail. + roots add: world activeHand; addAll: classList; addAll: (classList collect: [:cls | cls class]). + + roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail" + + catList do: [:sysCat | + (SystemOrganization listAtCategoryNamed: sysCat asSymbol) do: [:symb | + roots add: (Smalltalk at: symb); add: (Smalltalk at: symb) class]]. + + is := ImageSegment new copySmartRootsExport: roots asArray. + "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)" + + is state = #tooBig ifTrue: [^ false]. + + str := ''. + "considered legal to save a project that has never been entered" + (is outPointers includes: world) ifTrue: [ + str := str, '\Project''s own world is not in the segment.' withCRs]. + str isEmpty ifFalse: [ + ans := (UIManager default + chooseFrom: #('Do not write file' 'Write file anyway' 'Debug') + title: str). + ans = 1 ifTrue: [ + revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. + ^ false]. + ans = 3 ifTrue: [self halt: 'Segment not written']]. + + is writeForExportWithSources: aFileName inDirectory: aDirectory. + revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. + holder. + world flapTabs do: [:ft | + (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. + is arrayOfRoots do: [:obj | + obj class == ScriptEditorMorph ifTrue: [obj unhibernate]]. + ^ true + ! Item was added: + ----- Method: MorphicProject>>storeOnServerWithProgressInfoOn: (in category 'file in/out') ----- + storeOnServerWithProgressInfoOn: aMorphOrNil + + "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." + + ComplexProgressIndicator new + targetMorph: aMorphOrNil; + historyCategory: 'project storing'; + withProgressDo: [self storeOnServerInnards] + ! Item was added: + ----- Method: MorphicProject>>setPaletteFor: (in category 'language') ----- + setPaletteFor: aLanguageSymbol + | prototype formKey form | + + self flag: #toRemove. "check if this method still used by Etoys" + prototype := PaintBoxMorph prototype. + formKey := ('offPalette' , aLanguageSymbol) asSymbol. + form := Imports default imports + at: formKey + ifAbsent: [Imports default imports + at: #offPaletteEnglish + ifAbsent: []]. + form isNil ifFalse: [prototype loadOffForm: form]. + formKey := ('pressedPalette' , aLanguageSymbol) asSymbol. + form := Imports default imports + at: formKey + ifAbsent: [Imports default imports + at: #pressedPaletteEnglish + ifAbsent: []]. + form isNil ifFalse: [prototype loadPressedForm: form]. + ! Item was added: + ----- Method: MorphicProject>>storeSegmentNoFile (in category 'file in/out') ----- + storeSegmentNoFile + "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)" + + | is str | + (World == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." + world isInMemory ifFalse: [^ self]. "already done" + world ifNil: [^ self]. world presenter ifNil: [^ self]. + + "Do this on project enter" + World flapTabs do: [:ft | ft referent adaptToWorld: World]. + "Hack to keep the Menu flap from pointing at my project" + "Preferences setPreference: #useGlobalFlaps toValue: false." + "Utilities globalFlapTabsIfAny do: + [:aFlapTab | Utilities removeFlapTab: aFlapTab keepInList: false]. + Utilities clobberFlapTabList. " + "project world deleteAllFlapArtifacts." + "self currentWorld deleteAllFlapArtifacts. " + Utilities emptyScrapsBook. + World checkCurrentHandForObjectToPaste2. + + is := ImageSegment new copyFromRootsLocalFileFor: + (Array with: world presenter with: world) "world, and all Players" + sizeHint: 0. + + is segment size < 800 ifTrue: ["debugging" + Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep]. + false ifTrue: [ + str := String streamContents: [:strm | + strm nextPutAll: 'Only a tiny part of the project got into the segment'. + strm nextPutAll: '\These are pointed to from the outside:' withCRs. + is outPointers do: [:out | + (out class == Presenter) | (out class == ScriptEditorMorph) ifTrue: [ + strm cr. out printOn: strm. + self systemNavigation + browseAllObjectReferencesTo: out + except: (Array with: is outPointers) + ifNone: [:obj | ]]. + (is arrayOfRoots includes: out class) ifTrue: [strm cr. out printOn: strm. + self systemNavigation + browseAllObjectReferencesTo: out + except: (Array with: is outPointers) + ifNone: [:obj | ]]]]. + self inform: str. + ^ is inspect]. + + is extract. + "is instVarAt: 2 put: is segment clone." "different memory" + ! Item was added: + ----- Method: MorphicProject>>storeSegment (in category 'file in/out') ----- + storeSegment + "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***" + + | is sizeHint | + (World == world) ifTrue: [^ false]. + "self inform: 'Can''t send the current world out'." + world isInMemory ifFalse: [^ false]. "already done" + world ifNil: [^ false]. world presenter ifNil: [^ false]. + + Utilities emptyScrapsBook. + World checkCurrentHandForObjectToPaste. + world releaseSqueakPages. + sizeHint := self projectParameters at: #segmentSize ifAbsent: [0]. + + is := ImageSegment new copyFromRootsLocalFileFor: + (Array with: world presenter with: world) "world, and all Players" + sizeHint: sizeHint. + + is state = #tooBig ifTrue: [^ false]. + is segment size < 2000 ifTrue: ["debugging" + Transcript show: self name, ' only ', is segment size printString, + 'bytes in Segment.'; cr]. + self projectParameters at: #segmentSize put: is segment size. + is extract; writeToFile: self name. + ^ true + ! Item was added: + ----- Method: MorphicProject>>exportSegmentWithChangeSet:fileName:directory: (in category 'file in/out') ----- + exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName + directory: aDirectory + "Store my project out on the disk as an *exported* + ImageSegment. All outPointers will be in a form that can be resolved + in the target image. Name it <project name>.extSeg. Whatdo we do + about subProjects, especially if they are out as local image + segments? Force them to come in? + Player classes are included automatically." + + | is str ans revertSeg roots holder collector fd mgr stacks | + + "Files out a changeSet first, so that a project can contain + its own classes" + world ifNil: [^ false]. world presenter ifNil: [^ false]. + + Utilities emptyScrapsBook. + world currentHand pasteBuffer: nil. "don't write the paste buffer." + world currentHand mouseOverHandler initialize. "forget about any + references here" + "Display checkCurrentHandForObjectToPaste." + Command initialize. + world clearCommandHistory. + world fullReleaseCachedState; releaseViewers. + world cleanseStepList. + world localFlapTabs size = world flapTabs size ifFalse: [ + self error: 'Still holding onto Global flaps']. + world releaseSqueakPages. + ScriptEditorMorph writingUniversalTiles: (self projectParameterAt: + #universalTiles ifAbsent: [false]). + holder := Project allProjects. "force them in to outPointers, where + DiskProxys are made" + + "Just export me, not my previous version" + revertSeg := self projectParameters at: #revertToMe ifAbsent: [nil]. + self projectParameters removeKey: #revertToMe ifAbsent: []. + + roots := OrderedCollection new. + roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail. + roots add: world activeHand. + + "; addAll: classList; addAll: (classList collect: [:cls | cls class])" + + roots := roots reject: [ :x | x isNil]. "early saves may not have + active hand or thumbnail" + + fd := aDirectory directoryNamed: self resourceDirectoryName. + fd assureExistence. + "Clean up resource references before writing out" + mgr := self resourceManager. + self resourceManager: nil. + ResourceCollector current: ResourceCollector new. + ResourceCollector current localDirectory: fd. + ResourceCollector current baseUrl: self resourceUrl. + ResourceCollector current initializeFrom: mgr. + ProgressNotification signal: '2:findingResources' extra: + '(collecting resources...)' translated. + "Must activate old world because this is run at #armsLength. + Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent + will not be captured correctly if referenced from blocks or user code." + world becomeActiveDuring:[ + is := ImageSegment new copySmartRootsExport: roots asArray. + "old way was (is := ImageSegment new + copyFromRootsForExport: roots asArray)" + ]. + self resourceManager: mgr. + collector := ResourceCollector current. + ResourceCollector current: nil. + ProgressNotification signal: '2:foundResources' extra: ''. + is state = #tooBig ifTrue: [ + collector replaceAll. + ^ false]. + + str := ''. + "considered legal to save a project that has never been entered" + (is outPointers includes: world) ifTrue: [ + str := str, '\Project''s own world is not in the segment.' translated withCRs]. + str isEmpty ifFalse: [ + ans := UIManager default chooseFrom: { + 'Do not write file' translated. + 'Write file anyway' translated. + 'Debug' translated. + } title: str. + ans = 1 ifTrue: [ + revertSeg ifNotNil: [projectParameters at: + #revertToMe put: revertSeg]. + collector replaceAll. + ^ false]. + ans = 3 ifTrue: [ + collector replaceAll. + self halt: 'Segment not written' translated]]. + stacks := is findStacks. + + is + writeForExportWithSources: aFileName + inDirectory: fd + changeSet: aChangeSetOrNil. + SecurityManager default signFile: aFileName directory: fd. + "Compress all files and update check sums" + collector forgetObsolete. + self storeResourceList: collector in: fd. + self storeHtmlPageIn: fd. + self storeManifestFileIn: fd. + self writeStackText: stacks in: fd registerIn: collector. + "local proj.005.myStack.t" + self compressFilesIn: fd to: aFileName in: aDirectory + resources: collector. + "also deletes the resource directory" + "Now update everything that we know about" + mgr updateResourcesFrom: collector. + + revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg]. + holder. + + collector replaceAll. + + world flapTabs do: [:ft | + (ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]]. + is arrayOfRoots do: [:obj | + obj class == ScriptEditorMorph ifTrue: [obj unhibernate]]. + ^ true + ! Item was added: + ----- Method: MorphicProject>>chooseNaturalLanguage (in category 'language') ----- + chooseNaturalLanguage + "Put up a menu allowing the user to choose the natural language for the project" + + | aMenu availableLanguages | + aMenu := MenuMorph new defaultTarget: self. + aMenu addTitle: 'choose language' translated. + aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed. It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system. Each project has its own private language choice' translated. + Preferences noviceMode + ifFalse:[aMenu addStayUpItem]. + + availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs + asSortedCollection:[:x :y | x displayName < y displayName]. + + availableLanguages do: + [:localeID | + aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector: #switchAndInstallFontToID: argumentList: {localeID}]. + aMenu popUpInWorld + + "Project current chooseNaturalLanguage"! Item was added: + ----- Method: MorphicProject>>storeOnServerWithProgressInfo (in category 'file in/out') ----- + storeOnServerWithProgressInfo + + "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." + + ComplexProgressIndicator new + targetMorph: nil; + historyCategory: 'project storing'; + withProgressDo: [self storeOnServerInnards] + !

1 0

The Trunk: Morphic-dtl.258.mcz
by commits＠source.squeak.org 30 Nov '09

30 Nov '09

1 0

The Trunk: Morphic-dtl.258.mcz
by commits＠source.squeak.org 30 Nov '09

30 Nov '09

1 0

The Trunk: ST80-dtl.72.mcz
by commits＠source.squeak.org 30 Nov '09

30 Nov '09

David T. Lewis uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-dtl.72.mcz ==================== Summary ==================== Name: ST80-dtl.72 Author: dtl Time: 29 November 2009, 7:22:09 am UUID: 8fb563e0-7096-4b61-a188-dc1363274d29 Ancestors: ST80-dtl.71 Remove all remaining explicit MVC and Morphic dependencies (hopefully) from class Project. =============== Diff against ST80-dtl.71 =============== Item was added: + ----- Method: MVCProject>>exportSegmentWithCatagories:classes:fileName:directory: (in category 'file in/out') ----- + exportSegmentWithCatagories: catList classes: classList fileName: aFileName directory: aDirectory + "Store my project out on the disk as an *exported* ImageSegment. All outPointers will be in a form that can be resolved in the target image. Name it <project name>.extSeg. What do we do about subProjects, especially if they are out as local image segments? Force them to come in? + Player classes are included automatically." + + self flag: #toRemove. + self halt. "unused" + "world == World ifTrue: [^ false]." + "self inform: 'Can''t send the current world out'." + self projectParameters at: #isMVC put: true. + ^ false "Only Morphic projects for now" + ! Item was added: + ----- Method: MVCProject>>storeSegment (in category 'file in/out') ----- + storeSegment + "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***" + + (World == world) ifTrue: [^ false]. + "self inform: 'Can''t send the current world out'." + world isInMemory ifFalse: [^ false]. "already done" + self projectParameters at: #isMVC put: true. + ^ false "Only Morphic projects for now" + ! Item was added: + ----- Method: MVCProject>>exportSegmentWithChangeSet:fileName:directory: (in category 'file in/out') ----- + exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName + directory: aDirectory + "Store my project out on the disk as an *exported* + ImageSegment. All outPointers will be in a form that can be resolved + in the target image. Name it <project name>.extSeg. Whatdo we do + about subProjects, especially if they are out as local image + segments? Force them to come in? + Player classes are included automatically." + + "Files out a changeSet first, so that a project can contain + its own classes" + self projectParameters at: #isMVC put: true. + ^ false "Only Morphic projects for now" + ! Item was added: + ----- Method: MVCProject>>initializeProjectPreferences (in category 'project parameters') ----- + initializeProjectPreferences + "Initialize the project's preferences from currently-prevailing preferences that are currently being held in projects in this system" + + self flapsSuppressed: true. + super initializeProjectPreferences + ! Item was added: + ----- Method: MVCProject>>storeSegmentNoFile (in category 'file in/out') ----- + storeSegmentNoFile + "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)" + + (World == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'." + world isInMemory ifFalse: [^ self]. "already done" + self projectParameters at: #isMVC put: true. + ^ self "Only Morphic projects for now" + !

1 0

The Trunk: ST80-dtl.72.mcz
by commits＠source.squeak.org 30 Nov '09

30 Nov '09

1 0

The Trunk: ST80-dtl.72.mcz
by commits＠source.squeak.org 30 Nov '09

30 Nov '09

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages November 2009