[squeak-dev] The Trunk: SMLoader-cmm.64.mczcommits at source.squeak.org commits at source.squeak.orgSat Feb 12 22:49:12 UTC 2011
Chris Muller uploaded a new version of SMLoader to project The Trunk: http://source.squeak.org/trunk/SMLoader-cmm.64.mcz ==================== Summary ==================== Name: SMLoader-cmm.64 Author: cmm Time: 28 January 2011, 5:50:57.528 pm UUID: c355f38b-1468-4b82-849b-c1395e24da74 Ancestors: SMLoader-cmm.63 - You can now select 'Edit Release' or 'Create a New Release' from the SqueakMap menu to create new SqueakMap releases from within the image. - Introducing SMClient, which employs WebClient (dynamically loaded, if necessary), to post new releases to the SqueakMap http server via the new ToolBuilder-based UI; SMReleaseBrowser. - Window color of ReleaseBrowser match the SqueakMap browser. - Inherit from CodeHolder for the annotated code-pane. - Close the window on Save, busy cursor. - If the loadScript filename ends in '.st', load it into the code-pane. - Added username + password fields to the browser. - Remove parentVersion field; it's actually not that important. - Automatically upload the loadScript to SqueakMap on Save. - Default selections when creating a new package. =============== Diff against SMLoader-cmm.63 =============== Item was added: + ----- Method: SMAccount>>downloadsDirectory (in category '*smloader') ----- + downloadsDirectory + "Get the directory for uploaded files, create it if missing." + ^ 'http://' , SMSqueakMap findServer , '/accountbyid/' , self id asString , '/files'! Item was added: + Object subclass: #SMClient + instanceVariableNames: 'client' + classVariableNames: '' + poolDictionaries: '' + category: 'SMLoader'! + + !SMClient commentStamp: 'cmm 1/28/2011 16:06' prior: 0! + I can be used to save packages to the SqueakMap server.! Item was added: + ----- Method: SMClient classSide>>assureWebClient (in category 'private') ----- + assureWebClient + ^ (Smalltalk classNamed: #WebClient) ifNil: + [ self installWebClient. + Smalltalk classNamed: #WebClient ]! Item was added: + ----- Method: SMClient classSide>>installWebClient (in category 'private') ----- + installWebClient + (Installer repository: 'http://www.squeaksource.com/WebClient') + install: 'WebClient-Core-ar.83'! Item was added: + ----- Method: SMClient>>client (in category 'private') ----- + client + ^ client ifNil: + [ client := self class assureWebClient new + allowRedirect: false ; + yourself ]! Item was added: + ----- Method: SMClient>>close (in category 'api') ----- + close + self logout. + client ifNotNil: [ client close ]. + client := nil! Item was added: + ----- Method: SMClient>>initialize (in category 'initialize-release') ----- + initialize + super initialize. + self username: Utilities authorInitialsPerSe ! Item was added: + ----- Method: SMClient>>login (in category 'api') ----- + login + | response | + response := self client + httpPost: self smUrl, '/login' + content: 'uusername=' , self username , '&ppassword=', self password, '&requestedUrl=%2Faccount&1-4=Log+in' + type: 'application/x-www-form-urlencoded' + do: [ : req | req headerAt: 'Connection' put: 'Keep-Alive' ]. + (#(200 302 ) includes: response code) ifFalse: [ self error: 'login error' ]. + "Eat up content." + response content. + ^ response! Item was added: + ----- Method: SMClient>>logout (in category 'private') ----- + logout + ^ (client notNil and: [ client isConnected ]) ifTrue: + [ (self client httpGet: self smUrl , '/account/logout') + content ; + yourself ]! Item was added: + ----- Method: SMClient>>password (in category 'api') ----- + password + "The SqueakMap user password." + ^ client ifNotNil: [ client password ]! Item was added: + ----- Method: SMClient>>password: (in category 'api') ----- + password: aString + "The SqueakMap user password." + self client password: aString! Item was added: + ----- Method: SMClient>>save: (in category 'api') ----- + save: aSMPackageRelease + "Save aSMPackageRelease to the SqueakMap server." + | response | + response := self client + httpPost: self smUrl , '/account/package/' , aSMPackageRelease package id asString , '/editreleases' + content: aSMPackageRelease httpPostContent + type: 'application/x-www-form-urlencoded' + do: + [ : req | req + headerAt: 'Connection' + put: 'Keep-Alive' ]. + ^ response + content ; + yourself! Item was added: + ----- Method: SMClient>>smUrl (in category 'private') ----- + smUrl + ^ "'http://map.squeak.org'" 'http://localhost:8080'! Item was added: + ----- Method: SMClient>>uploadFile: (in category 'api') ----- + uploadFile: aDirectoryEntryFile + "Upload aDirectoryEntryFile to the uploads area of SqueakMap for my userId." + | boundary fieldMap fileStream doc | + fileStream := aDirectoryEntryFile readStream binary. + [ doc := MIMEDocument + contentType: (MIMEDocument guessTypeFromName: aDirectoryEntryFile name) + content: fileStream contents + url: fileStream asUrl ] ensure: + [ fileStream ifNotNil: [ fileStream close ] ]. + boundary := WebUtils multipartBoundary. + fieldMap := {'upload' -> doc}. + ^ (self client + httpPost: self smUrl , '/account/upload' + content: + (WebUtils + encodeMultipartForm: fieldMap + boundary: boundary) + type: MIMEDocument contentTypeMultipart , '; boundary=' , boundary + do: [ : req | req headerAt: 'Connection' put: 'keep-alive' ]) + content ; + yourself! Item was added: + ----- Method: SMClient>>uploadFileNamed: (in category 'api') ----- + uploadFileNamed: filename + "Upload filename to the uploads area of SqueakMap for my userId." + ^ self uploadFile: (FileDirectory default entryAt: filename)! Item was added: + ----- Method: SMClient>>username (in category 'api') ----- + username + "The SqueakMap username." + ^ client ifNotNil: [ client username ]! Item was added: + ----- Method: SMClient>>username: (in category 'api') ----- + username: aString + "The SqueakMap username." + self client username: aString! Item was added: + ----- Method: SMLoader>>createNewRelease (in category 'private') ----- + createNewRelease + SMReleaseBrowser + openOn: self selectedItem newUnattachedRelease initializeMandatoryCategories ; + yourself! Item was changed: ----- Method: SMLoader>>packageSpecificOptions (in category 'menus') ----- packageSpecificOptions | choices packageOrRelease | packageOrRelease := self selectedPackageOrRelease. choices := OrderedCollection new. + packageOrRelease isInstallable ifTrue: [ choices add: self buttonSpecs first ]. + (packageOrRelease isDownloadable and: [ packageOrRelease isCached ]) ifTrue: [ choices add: self buttonSpecs third ]. + (packageOrRelease isPackageRelease and: [ packageOrRelease isDownloadable ]) ifTrue: + [ choices add: #('Copy from cache' #cachePackageReleaseAndOfferToCopy 'Download selected release into cache first if needed, and then offer to copy it somewhere else.' ). + choices add: #('Force download into cache' #downloadPackageRelease 'Force a download of the selected release into the cache.' ). + packageOrRelease isPackageRelease ifTrue: [ choices add: #('Edit Release' #openReleaseEditor 'Open a browser on this release to make updates.' ) ]. + choices add: #('Create new Release' #createNewRelease 'Create a new release based on this release' ) ]. - packageOrRelease isInstallable ifTrue: [ - choices add: self buttonSpecs first]. - (packageOrRelease isDownloadable and: [packageOrRelease isCached]) ifTrue: [ - choices add: self buttonSpecs third]. - - (packageOrRelease isPackageRelease and: [packageOrRelease isDownloadable]) ifTrue: [ - choices add: #('Copy from cache' #cachePackageReleaseAndOfferToCopy 'Download selected release into cache first if needed, and then offer to copy it somewhere else.' ). - choices add: #('Force download into cache' #downloadPackageRelease 'Force a download of the selected release into the cache.' )]. choices add: self buttonSpecs second. ^ choices! Item was changed: ----- Method: SMLoaderPlus classSide>>initialize (in category 'class initialization') ----- initialize "Hook us up in the world menu." - "self initialize" + Smalltalk + at: #ToolBuilder + ifPresent: + [ : tb | self registerInFlapsRegistry. + (Preferences windowColorFor: #SMLoader) = Color white "note set" ifTrue: + [ + #(#SMLoader #SMReleaseBrowser ) do: + [ : each | + Preferences + setWindowColorFor: each + to: (Color colorFrom: self windowColorSpecification brightColor) ] ]. + (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: + [ | oldCmds | + oldCmds := TheWorldMenu registry select: + [ : cmd | cmd first includesSubString: 'Package Loader' ]. + oldCmds do: + [ : cmd | TheWorldMenu unregisterOpenCommand: cmd first ]. + TheWorldMenu registerOpenCommand: {self openMenuString. + {self. + #open}} ] ]. - - Smalltalk at: #ToolBuilder ifPresent: [:tb | - self registerInFlapsRegistry. - (Preferences windowColorFor: #SMLoader) = Color white "not set" - ifTrue: [ Preferences setWindowColorFor: #SMLoader to: (Color colorFrom: self windowColorSpecification brightColor) ]. - (TheWorldMenu respondsTo: #registerOpenCommand:) - ifTrue: [| oldCmds | - oldCmds := TheWorldMenu registry select: [:cmd | cmd first includesSubString: 'Package Loader']. - oldCmds do: [:cmd | TheWorldMenu unregisterOpenCommand: cmd first]. - TheWorldMenu registerOpenCommand: {self openMenuString. {self. #open}}]]. DefaultFilters := OrderedCollection new. DefaultCategoriesToFilterIds := OrderedCollection new! Item was changed: ----- Method: SMLoaderPlus>>commandSpecs (in category 'menus') ----- commandSpecs ^ #(('Install' installPackageRelease 'Install the latest version from the server.' (item all)) ('Email' emailPackageMaintainers 'Open an editor to send an email to the owner and co-maintainers of this package.' (item all)) ('Browse cache' browseCacheDirectory 'Browse cache directory of the selection.' (item all)) ('Copy from cache' cachePackageReleaseAndOfferToCopy 'Download selected release into cache first if needed, and then offer to copy it somewhere else.' (item)) + ('Edit Release' openReleaseEditor 'Open a browser on this release to make updates.' (item)) + ('Create new Release' createNewRelease 'Create a new release based on the selected item' (item)) ('Force download into cache' downloadPackageRelease 'Force a download of the selected release into the cache.' (item)) ('Update' loadUpdates 'Update the package index from the servers.' (all)) ('Upgrade All' upgradeInstalledPackagesConfirm 'Upgrade all installed packages (confirming each).' (all)) ('Upgrade all installed packages' upgradeInstalledPackagesNoConfirm '' (item)) ('Upgrade all installed packages confirming each' upgradeInstalledPackagesConfirm '' (item)) ('Copy list' listInPasteBuffer 'Puts the list as text into the clipboard.' (all)) ('Save filters' saveFiltersAsDefault 'Saves the current filters as default.' (all)) ('Help' help 'What is this?' (all)))! Item was added: + ----- Method: SMLoaderPlus>>createNewRelease (in category 'actions') ----- + createNewRelease + SMReleaseBrowser + openOn: self selectedItem newUnattachedRelease initializeMandatoryCategories ; + yourself! Item was added: + ----- Method: SMLoaderPlus>>openReleaseEditor (in category 'actions') ----- + openReleaseEditor + SMReleaseBrowser openOn: self selectedItem ! Item was changed: ----- Method: SMLoaderPlus>>packageSpecificOptions (in category 'menus') ----- packageSpecificOptions | choices packageOrRelease | packageOrRelease := self selectedPackageOrRelease. choices := OrderedCollection new. + packageOrRelease isInstallable ifTrue: [ choices add: (self commandSpecFor: #installPackageRelease) ]. + (packageOrRelease isDownloadable and: [ packageOrRelease isCached ]) ifTrue: [ choices add: (self commandSpecFor: #browseCacheDirectory) ]. + (packageOrRelease isPackageRelease and: [ packageOrRelease isDownloadable ]) ifTrue: + [ choices add: (self commandSpecFor: #cachePackageReleaseAndOfferToCopy). + choices add: (self commandSpecFor: #downloadPackageRelease) ]. - packageOrRelease isInstallable ifTrue: [ - choices add: (self commandSpecFor: #installPackageRelease)]. - (packageOrRelease isDownloadable and: [packageOrRelease isCached]) ifTrue: [ - choices add: (self commandSpecFor: #browseCacheDirectory)]. - (packageOrRelease isPackageRelease and: [packageOrRelease isDownloadable]) ifTrue: [ - choices add: (self commandSpecFor: #cachePackageReleaseAndOfferToCopy). - choices add: (self commandSpecFor: #downloadPackageRelease)]. choices add: (self commandSpecFor: #emailPackageMaintainers). + packageOrRelease isPackageRelease ifTrue: [ choices add: (self commandSpecFor: #openReleaseEditor) ]. + choices add: (self commandSpecFor: #createNewRelease). ^ choices! Item was added: + ----- Method: SMPackage>>newUnattachedRelease (in category '*smloader') ----- + newUnattachedRelease + "Create a new release that is not part of the packages list of releases. That does not happen until the user clicks Save on the UI." + ^ self newUnattachedReleaseFrom: self lastRelease ! Item was added: + ----- Method: SMPackage>>newUnattachedReleaseFrom: (in category '*smloader') ----- + newUnattachedReleaseFrom: parentRelease + "Create a new release that is not part of the packages list of releases. That does not happen until the user clicks Save on the UI." + ^(map newObject: (SMPackageRelease newFromRelease: parentRelease package: self))! Item was added: + ----- Method: SMPackageRelease>>compatibility (in category '*smloader') ----- + compatibility + ^ self categories + detect: + [ : each | each parent = self map compatibilityLevels ] + ifNone: [ ]! Item was added: + ----- Method: SMPackageRelease>>compatibility: (in category '*smloader') ----- + compatibility: aSMCategory + | comp | + aSMCategory parent = self map compatibilityLevels ifFalse: [ self error: 'Not a compatibility category.' ]. + [ comp := self compatibility. + comp notNil ] whileTrue: [ self removeCategory: comp ]. + self addCategory: aSMCategory! Item was added: + ----- Method: SMPackageRelease>>compatibilityIndex (in category '*smloader') ----- + compatibilityIndex + "Answer my position in the list of my maps compatibilitys." + ^ self map compatibilityLevels subCategories indexOf: self compatibility! Item was added: + ----- Method: SMPackageRelease>>fullyQualifiedScriptName (in category '*smloader') ----- + fullyQualifiedScriptName + ^ self package owner downloadsDirectory , self scriptName ! Item was added: + ----- Method: SMPackageRelease>>httpPostContent (in category '*smloader') ----- + httpPostContent + "Answer the url-encoded parameters for this object." + | allCategories | + ^ String streamContents: [ : stream | | isNew | + isNew := self isNewObject. + "releaseIndex is dependent on my being one of my package's releases." + self package addRelease: self. + self releaseIndex > 0 ifTrue: [stream nextPutAll: '1-1=', (self releaseIndex) , '&' ]. + stream + nextPutAll: '1-3=', self version asString encodeForHTTP ; + "The following category fields must remain in alphabetical order. Add 1 to category indexes because web-server expects the first item to always be nil." + nextPutAll: '&1-4=', (self compatibilityIndex+1) ; + nextPutAll: '&1-5=', (self licenseIndex+1) ; + nextPutAll: '&1-6=', (self maturityIndex+1) ; + nextPutAll: '&1-7=', (self squeakVersionIndex+1) ; + nextPutAll: '&1-8=', self downloadUrl "already http encoded" ; + nextPutAll: '&1-9=1&1-10=&1-11=' "No file selection, 'cool' name or summary". + "Specify only the mandatory categories for 'additional categories', otherwise prior mandatory selections will be reflected in the objects categories, causing the highest-in-the-list to always win. Ugh.." + allCategories := SMSqueakMap default categories asSortedCollection: [ : a : b | a name < b name ]. + { allCategories indexOf: (self compatibility). allCategories indexOf: (self license). allCategories indexOf: (self maturity). allCategories indexOf: (self squeakVersion) } do: + [ : each | stream nextPutAll: '&1-12=', each asString ]. + stream nextPutAll: '&1-13=', self note asString encodeForHTTP. + isNew + ifTrue: [ self stream nextPutAll: '&1-18=Save+as+new+release' ] + ifFalse: [ stream nextPutAll: '&1-17=Save+changes' ]. + self parentRelease ifNotNilDo: + [ : pr | stream + nextPutAll: '&1-19=', pr releaseIndex ] ]! Item was added: + ----- Method: SMPackageRelease>>initializeMandatoryCategories (in category '*smloader') ----- + initializeMandatoryCategories + "Set default mandatory categories." + self + license: self map mit ; + squeakVersion: self map currentSqueakVersion ; + compatibility: self map onlyExtensions ; + maturity: self map alpha! Item was added: + ----- Method: SMPackageRelease>>isNewObject (in category '*smloader') ----- + isNewObject + ^ self package releases includes: self! Item was added: + ----- Method: SMPackageRelease>>license (in category '*smloader') ----- + license + ^ self categories + detect: + [ : each | each parent = self map licenses ] + ifNone: [ ]! Item was added: + ----- Method: SMPackageRelease>>license: (in category '*smloader') ----- + license: aSMCategory + | lic | + aSMCategory parent = self map licenses ifFalse: [ self error: 'Not a license category.' ]. + [ lic := self license. + lic notNil ] whileTrue: [ self removeCategory: lic ]. + self addCategory: aSMCategory! Item was added: + ----- Method: SMPackageRelease>>licenseIndex (in category '*smloader') ----- + licenseIndex + "Answer my position in the list of my maps licenses." + ^ self map licenses subCategories indexOf: self license! Item was added: + ----- Method: SMPackageRelease>>maturity (in category '*smloader') ----- + maturity + ^ self categories + detect: + [ : each | each parent = self map maturityLevels ] + ifNone: [ nil ]! Item was added: + ----- Method: SMPackageRelease>>maturity: (in category '*smloader') ----- + maturity: aSMCategory + | mat | + aSMCategory parent = self map maturityLevels ifFalse: [ self error: 'Not a maturity category.' ]. + [ mat := self maturity. + mat notNil ] whileTrue: [ self removeCategory: mat ]. + self addCategory: aSMCategory! Item was added: + ----- Method: SMPackageRelease>>maturityIndex (in category '*smloader') ----- + maturityIndex + "Answer my position in the list of my maps maturitys." + ^ self map maturityLevels subCategories indexOf: self maturity! Item was added: + ----- Method: SMPackageRelease>>newUnattachedRelease (in category '*smloader') ----- + newUnattachedRelease + "Create and answer a new release based on this release." + ^ self package newUnattachedReleaseFrom: self! Item was added: + ----- Method: SMPackageRelease>>releaseIndex (in category '*smloader') ----- + releaseIndex + "Answer my position in the list of my packages releases." + ^ self package releases indexOf: self! Item was added: + ----- Method: SMPackageRelease>>scriptName (in category '*smloader') ----- + scriptName + ^ 'install', self id asString, '.st'! Item was added: + ----- Method: SMPackageRelease>>squeakVersion (in category '*smloader') ----- + squeakVersion + ^ self categories + detect: + [ : each | each parent = self map squeakVersions ] + ifNone: [ ]! Item was added: + ----- Method: SMPackageRelease>>squeakVersion: (in category '*smloader') ----- + squeakVersion: aSMCategory + | vers | + aSMCategory parent = self map squeakVersions ifFalse: [ self error: 'Not a squeakVersion category.' ]. + "Remove all squeakVersion-categories." + [ vers := self squeakVersion. + vers notNil ] whileTrue: [ self removeCategory: vers ]. + self addCategory: aSMCategory! Item was added: + ----- Method: SMPackageRelease>>squeakVersionIndex (in category '*smloader') ----- + squeakVersionIndex + "Answer my position in the list of my maps squeakVersions." + ^ self map squeakVersions subCategories indexOf: self squeakVersion! Item was changed: + CodeHolder subclass: #SMReleaseBrowser + instanceVariableNames: 'release loadScript smClient' - StringHolder subclass: #SMReleaseBrowser - instanceVariableNames: 'release licenses squeakVersions compatibilities maturities loadScript' classVariableNames: '' poolDictionaries: '' + category: 'SMLoader'! - category: 'SMLoader-Models'! !SMReleaseBrowser commentStamp: 'cmm 1/23/2011 17:44' prior: 0! A browser for specific SqueakMap packages. - Across the top: - version name text input (across the top) - parent release (uneditable text) - Four lists across the width: - license single-select. - versions multi-select. - compatibility single-select. - maturity single-select. X File to upload | elipsis. - Load-script paragraph | Release notes paragraph. - Buttons: - Save. - Cancel. ! Item was added: + ----- Method: SMReleaseBrowser classSide>>windowColorSpecification (in category 'window color') ----- + windowColorSpecification + "Answer a WindowColorSpec object that declares my preference." + ^WindowColorSpec + classSymbol: self name + wording: 'Package Release Browser' + brightColor: Color yellow muchLighter duller + pastelColor: Color yellow veryMuchLighter duller + helpMessage: 'The SqueakMap Release Browser'! Item was added: + ----- Method: SMReleaseBrowser>>annotation (in category 'toolbuilder') ----- + annotation + ^ String streamContents: + [ : stream | stream + nextPutAll: 'last saved ' ; + print: release updated ]! Item was added: + ----- Method: SMReleaseBrowser>>buildCodePaneWith: (in category 'toolbuilder') ----- + buildCodePaneWith: aToolBuilder + ^ (super buildCodePaneWith: aToolBuilder) + name: #content ; + yourself! Item was changed: ----- Method: SMReleaseBrowser>>buildWith: (in category 'toolbuilder') ----- buildWith: aToolBuilder | windowSpec row2Top row3Top | row2Top := 0.1. row3Top := 0.5. windowSpec := self buildWindowWith: aToolBuilder + specs: {(0 @ 0 corner: 0.5 @ 0.05) -> (self newVersionSpec: aToolBuilder). + (0.0 @ 0.05 corner: 0.5@ row2Top) -> (self newAuthenticationPane: aToolBuilder). + (0.5 @ 0 corner: 1.0 @ row2Top) -> (self newReleaseNotesPaneSpec: aToolBuilder). - specs: {(0 @ 0 corner: 0.5 @ row2Top) -> (self newVersionSpec: aToolBuilder). - (0.5 @ 0 corner: 1.0 @ row2Top) -> (self newParentVersionSpec: aToolBuilder). (0 at row2Top corner: 0.25 at row3Top) -> (self newLicenseListSpec: aToolBuilder). (0.25 at row2Top corner: 0.50 at row3Top) -> (self newSqueakVersionSpec: aToolBuilder). (0.50 at row2Top corner: 0.75 at row3Top) -> (self newCompatibilitySpec: aToolBuilder). (0.75 at row2Top corner: 1.00 at row3Top) -> (self newMaturitySpec: aToolBuilder). + (0.0 at row3Top corner: 1.00 at 1.00) -> (self buildCodePaneWith: aToolBuilder) }. - (0.0 at row3Top corner: 0.5 at 1.00) -> (self newLoadScriptPaneSpec: aToolBuilder). - (0.50 at row3Top corner: 1.00 at 1.00) -> (self newReleaseNotesPaneSpec: aToolBuilder) }. ^ aToolBuilder build: windowSpec! Item was added: + ----- Method: SMReleaseBrowser>>closeWindow (in category 'private') ----- + closeWindow + self dependents do: + [ : each | each isSystemWindow ifTrue: [ each delete ] ]! Item was changed: ----- Method: SMReleaseBrowser>>compatibility: (in category 'model access') ----- compatibility: aSMCategory + release compatibility: aSMCategory. + self changed: #compatibility! - release compatibility: aSMCategory! Item was added: + ----- Method: SMReleaseBrowser>>contents (in category 'toolbuilder') ----- + contents + ^ self loadScript! Item was added: + ----- Method: SMReleaseBrowser>>contents: (in category 'model access') ----- + contents: aText + self loadScript: aText. + self changed: #contents! Item was added: + ----- Method: SMReleaseBrowser>>initialize (in category 'initialize-release') ----- + initialize + super initialize. + smClient := SMClient new! Item was changed: ----- Method: SMReleaseBrowser>>labelString (in category 'toolbuilder') ----- labelString + ^ String streamContents: + [ : stream | stream nextPutAll: release package name. + release version isEmptyOrNil ifFalse: + [ stream + space ; + nextPutAll: release version ] ]! - ^ release name, ' ', release version ! Item was changed: ----- Method: SMReleaseBrowser>>license: (in category 'model access') ----- license: aSMCategory + release license: aSMCategory. + self changed: #license! - ^ release license: aSMCategory! Item was changed: ----- Method: SMReleaseBrowser>>licenses (in category 'model access') ----- licenses + "Answer the 'Licenses' subCagegories." ^ SMSqueakMap default licenses subCategories! Item was changed: ----- Method: SMReleaseBrowser>>loadScript (in category 'model access') ----- loadScript + "The Smalltalk code needed to install this release of this package." + ^ loadScript ifNil: + [ | scriptName | + scriptName := release downloadFileName. + loadScript := scriptName isEmptyOrNil ifFalse: + [ (scriptName asLowercase endsWith: '.st') ifTrue: [ release contents ] ] ]! - ^ loadScript! Item was changed: ----- Method: SMReleaseBrowser>>loadScript: (in category 'model access') ----- loadScript: aString + "The Smalltalk code needed to load this release of this package." + loadScript := aString asString. + self changed: #loadScript! - loadScript := aString! Item was added: + ----- Method: SMReleaseBrowser>>login (in category 'private') ----- + login + smClient login! Item was added: + ----- Method: SMReleaseBrowser>>logout (in category 'private') ----- + logout + smClient close. + self + changed: #username ; + changed: #password! Item was changed: ----- Method: SMReleaseBrowser>>maturity: (in category 'model access') ----- maturity: aSMCategory + release maturity: aSMCategory. + self changed: #maturity! - release maturity: aSMCategory! Item was added: + ----- Method: SMReleaseBrowser>>newAuthenticationPane: (in category 'toolbuilder') ----- + newAuthenticationPane: aToolBuilder + ^ aToolBuilder pluggablePanelSpec new + model: self ; + children: + (OrderedCollection + with: + (aToolBuilder pluggableInputFieldSpec new + model: self ; + name: #username ; + help: 'Your SqueakMap Id.' ; + getText: #username ; + setText: #username: ; + frame: (0.02 at 0 corner: 0.38 at 1) ; + yourself) + with: + (aToolBuilder pluggableInputFieldSpec new + model: self ; + name: #password ; + help: 'Your SqueakMap password.' ; + getText: #password ; + setText: #password: ; + frame: (0.40 at 0 corner: 0.75 at 1) ; + yourself) + with: + (aToolBuilder pluggableButtonSpec new + model: self ; + help: 'Save this release to the SqueakMap server' ; + label: 'Save' ; + action: #save ; + frame: (0.77 at 0 corner: 0.98 at 1) ; + yourself)) ; + yourself! Item was removed: - ----- Method: SMReleaseBrowser>>newLoadScriptPaneSpec: (in category 'toolbuilder') ----- - newLoadScriptPaneSpec: aToolBuilder - ^ aToolBuilder pluggableCodePaneSpec new - model: self ; - help: 'Smalltalk code which will load this package.' ; - askBeforeDiscardingEdits: true ; - getText: #loadScript ; - setText: #loadScript: ; - yourself! Item was removed: - ----- Method: SMReleaseBrowser>>newParentVersionSpec: (in category 'toolbuilder') ----- - newParentVersionSpec: aToolBuilder - ^ aToolBuilder pluggableInputFieldSpec new - model: release ; - name: #parentVersion ; - help: 'The parent version from which this release is based.' ; - getText: #parentVersion ; - askBeforeDiscardingEdits: false! Item was changed: ----- Method: SMReleaseBrowser>>newReleaseNotesPaneSpec: (in category 'toolbuilder') ----- newReleaseNotesPaneSpec: aToolBuilder ^ aToolBuilder pluggableTextSpec new model: self ; + name: #note ; help: 'Notes about this release.' ; askBeforeDiscardingEdits: true ; getText: #note ; setText: #note: ; yourself! Item was changed: ----- Method: SMReleaseBrowser>>note: (in category 'model access') ----- note: aString + release note: aString. + self changed: #note! - release note: aString! Item was added: + ----- Method: SMReleaseBrowser>>okToChange (in category 'toolbuilder') ----- + okToChange + "Answer true so that merely selecting different categories doesn't cause a pop-up." + ^ true! Item was added: + ----- Method: SMReleaseBrowser>>password (in category 'model access') ----- + password + "The SqueakMap password." + ^ smClient password! Item was added: + ----- Method: SMReleaseBrowser>>password: (in category 'model access') ----- + password: aString + "The SqueakMap username." + smClient password: aString asString. + self changed: #password! Item was added: + ----- Method: SMReleaseBrowser>>postInitialize (in category 'initialize-release') ----- + postInitialize + (release downloadUrl endsWith: '.st') ifTrue: + [ release ensureInCache ifTrue: [ self loadScript: release contents ] ]! Item was added: + ----- Method: SMReleaseBrowser>>save (in category 'initialize-release') ----- + save + "Save the release to SqueakMap." + Cursor wait showWhile: + [ self dependents do: + [ : eachWidget | #(#username #password #note #version #content ) do: + [ : eachName | eachWidget knownName = eachName ifTrue: + [ eachWidget hasUnacceptedEdits ifTrue: [ eachWidget accept ] ] ] ]. + [ self + writeInstallFile ; + login. + self loadScript isEmptyOrNil ifFalse: [ self uploadInstallFile ]. + self savePackageRelease ] ensure: [ self logout ] ]. + self closeWindow! Item was added: + ----- Method: SMReleaseBrowser>>savePackageRelease (in category 'private') ----- + savePackageRelease + | response | + release downloadUrl: release fullyQualifiedScriptName. + response := smClient save: release. + response isSuccess ifFalse: [ self halt: 'non-successful response' ]! Item was changed: ----- Method: SMReleaseBrowser>>setRelease: (in category 'initialize-release') ----- setRelease: aSMPackageRelease + release := aSMPackageRelease. + self postInitialize! - release := aSMPackageRelease! Item was changed: ----- Method: SMReleaseBrowser>>squeakVersion: (in category 'model access') ----- squeakVersion: aSMCategory + release squeakVersion: aSMCategory. + self changed: #squeakVersion! - release squeakVersion: aSMCategory! Item was changed: ----- Method: SMReleaseBrowser>>squeakVersions (in category 'model access') ----- squeakVersions + "Answer the squeak-versions subcategories." ^ SMSqueakMap default squeakVersions subCategories! Item was added: + ----- Method: SMReleaseBrowser>>uploadInstallFile (in category 'private') ----- + uploadInstallFile + | response | + response := smClient uploadFileNamed: release scriptName. + (#(200 302) includes: response code) ifFalse: [ self halt: 'non-successful response' ]! Item was added: + ----- Method: SMReleaseBrowser>>username (in category 'model access') ----- + username + "The SqueakMap username." + ^ smClient username! Item was added: + ----- Method: SMReleaseBrowser>>username: (in category 'model access') ----- + username: aString + "The SqueakMap username." + smClient username: aString asString. + self changed: #username! Item was changed: ----- Method: SMReleaseBrowser>>version: (in category 'model access') ----- version: aString release ifNotNil: [ release version: aString asString ]. + self + changed: #version ; + changed: #labelString! - self changed: #version! Item was added: + ----- Method: SMReleaseBrowser>>writeInstallFile (in category 'private') ----- + writeInstallFile + | filename | + filename := 'install' , release id asString , '.st'. + FileDirectory default deleteFileNamed: filename. + FileStream + fileNamed: filename + do: + [ : stream | stream nextPutAll: self loadScript asString ]! Item was added: + ----- Method: SMSqueakMap>>alpha (in category '*smloader') ----- + alpha + "Answer the default license selection for new packages, MIT." + ^ self categoryWithNameBeginning: 'Alpha'! Item was added: + ----- Method: SMSqueakMap>>currentSqueakVersion (in category '*smloader') ----- + currentSqueakVersion + "Answer the default license selection for new packages, MIT." + ^ (self categoryWithNameBeginning: SystemVersion current version) ifNil: [ (self categoryWithNameBeginning: 'trunk') ifNil: [ self squeakVersions subCategories last ] ]! Item was added: + ----- Method: SMSqueakMap>>licenses (in category '*smloader') ----- + licenses + ^ self categoryWithNameBeginning: 'Licenses'! Item was added: + ----- Method: SMSqueakMap>>maturityLevels (in category '*smloader') ----- + maturityLevels + ^ self categoryWithNameBeginning: 'Maturity level'! Item was added: + ----- Method: SMSqueakMap>>mit (in category '*smloader') ----- + mit + "Answer the default license selection for new packages, MIT." + ^ self categoryWithNameBeginning: 'MIT' ! Item was added: + ----- Method: SMSqueakMap>>onlyExtensions (in category '*smloader') ----- + onlyExtensions + "Answer the default license selection for new packages, MIT." + ^ self categoryWithNameBeginning: 'Only extensions, no changes'! Item was added: + ----- Method: SMSqueakMap>>squeakVersions (in category '*smloader') ----- + squeakVersions + "Answer the parent SMCategory whose sub-categories each represent a version of Squeak." + ^ self categoryWithNameBeginning: 'Squeak versions'!
More information about the Squeak-dev mailing list |