[squeak-dev] The Inbox: SMLoader-ct.98.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 14 14:11:48 UTC 2022
A new version of SMLoader was added to project The Inbox: http://source.squeak.org/inbox/SMLoader-ct.98.mcz ==================== Summary ==================== Name: SMLoader-ct.98 Author: ct Time: 18 May 2022, 7:28:33.967874 pm UUID: 86668f56-4011-d34c-bc66-a69a58e6898d Ancestors: SMLoader-mt.97 Improves multilingual support and fixes broken link to swiki. Moves from UIManager default to Project uiManager. =============== Diff against SMLoader-mt.97 =============== Item was removed: - SystemOrganization addCategory: #SMLoader! Item was removed: - ----- Method: FileList2 class>>morphicViewOnDirectory: (in category '*smloader-extension') ----- - morphicViewOnDirectory: aFileDirectory - | aFileList window fileListBottom midLine fileListTopOffset buttonPane | - - aFileList := self new directory: aFileDirectory. - window := (SystemWindow labelled: aFileDirectory pathName) model: aFileList. - - fileListTopOffset := (TextStyle defaultFont pointSize * 2) + 14. - fileListBottom := 0.4. - midLine := 0.4. - buttonPane := aFileList optionalButtonRow addMorph: - (aFileList morphicPatternPane vResizing: #spaceFill; yourself). - self addFullPanesTo: window from: { - {buttonPane. 0 at 0 corner: 1 at 0. 0 at 0 corner: 0 at fileListTopOffset}. - {aFileList morphicDirectoryTreePane. 0 at 0 corner: midLine at fileListBottom. - 0 at fileListTopOffset corner: 0 at 0}. - {aFileList morphicFileListPane. midLine @ 0 corner: 1 at fileListBottom. - 0 at fileListTopOffset corner: 0 at 0}. - {aFileList morphicFileContentsPane. 0 at fileListBottom corner: 1 at 1. nil}. - }. - aFileList postOpen. - ^ window ! Item was removed: - ----- 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 removed: - ListItemWrapper subclass: #SMCategoryWrapper - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'SMLoader'! - - !SMCategoryWrapper commentStamp: '<historical>' prior: 0! - This is a wrapper for showing the SqueakMap categories (SMCategory) using the SimpleHierarchicalListMorph in the SMLoader, see SMLoader>>categoryWrapperList.! Item was removed: - ----- Method: SMCategoryWrapper>>= (in category 'comparing') ----- - = anObject - ^self withoutListWrapper = anObject withoutListWrapper! Item was removed: - ----- Method: SMCategoryWrapper>>asString (in category 'converting') ----- - asString - ^ item name , ' (' , self numberOfObjects printString , ')'! Item was removed: - ----- Method: SMCategoryWrapper>>category (in category 'accessing') ----- - category - ^item! Item was removed: - ----- Method: SMCategoryWrapper>>contents (in category 'accessing') ----- - contents - ^ item subCategories - collect: [:n | self class with: n model: n]! Item was removed: - ----- Method: SMCategoryWrapper>>getList (in category 'model access') ----- - getList - ^ Array - with: (self class with: self contents model: model)! Item was removed: - ----- Method: SMCategoryWrapper>>hasContents (in category 'testing') ----- - hasContents - ^ item hasSubCategories! Item was removed: - ----- Method: SMCategoryWrapper>>hash (in category 'comparing') ----- - hash - ^self withoutListWrapper hash! Item was removed: - ----- Method: SMCategoryWrapper>>help (in category 'accessing') ----- - help - ^ 'The categories are structured in a tree. Packages and package releases belong to several categories. You can add one or more categories as filters and enable them in the menu.'! Item was removed: - ----- Method: SMCategoryWrapper>>model (in category 'accessing') ----- - model - ^model! Item was removed: - ----- Method: SMCategoryWrapper>>numberOfObjects (in category 'accessing') ----- - numberOfObjects - " | total | - total := 0. - model allCategoriesDo: [:c | - total := total + c objects size]. - ^total" - ^item objects size! Item was removed: - Object subclass: #SMClient - instanceVariableNames: 'client' - classVariableNames: '' - poolDictionaries: '' - category: 'SMLoader'! - - !SMClient commentStamp: 'cmm 1/30/2011 14:54' prior: 0! - I can be used to save packages to the SqueakMap server. Here are the fields to save a release: - - 1-1 = "Select release:" = 3 - 1-3 = "Version" = 100 - 1-4 = License drop-down index = 7 - 1-5 = Compatibility = 5 - 1-6 = Squeak versions = 11 - 1-7 = Maturity = 4 - 1-8 = Download url = http%3A%2F%2Fminnow.cc.gatech.edu%2Fsqueak%2Fuploads%2F2978%2FMa%2520client%2520server-cmm.mcz.sar - 1-9 = (file-selection drop-down) = 1 "None" - 1-10 = Name (a cool one if you want) = [empty string] - 1-11 = Summary = [empty string] - (1-12)* = Additional categories - 1-13 = Release note = This+version+much+faster+than+the+prior+SqueakMap+version.%0D%0A%0D%0AThis+single+release+installs+correctly+on+3.6%2C+3.7%2C+3.8%2C+3.9alpha+and+Jasmin+0.3++%28Croquet%29+images.%0D%0A%0D%0A - 1-17 = Button clicked = Save+changes - 1-18 = Button clicked = 'Save as new release' encodeForHTTP - 1-19 = parent release = 3! Item was removed: - ----- Method: SMClient class>>assureWebClient (in category 'private') ----- - assureWebClient - ^ (Smalltalk classNamed: #WebClient) ifNil: - [ self installWebClient. - Smalltalk classNamed: #WebClient ]! Item was removed: - ----- Method: SMClient class>>installWebClient (in category 'private') ----- - installWebClient - Installer ss - project: 'WebClient'; - install: 'WebClient-Core-ar.92.mcz'! Item was removed: - ----- Method: SMClient>>client (in category 'private') ----- - client - ^ client ifNil: - [ client := self class assureWebClient new - allowRedirect: false ; - yourself ]! Item was removed: - ----- Method: SMClient>>close (in category 'api') ----- - close - self logout. - client ifNotNil: [ client close ]. - client := nil! Item was removed: - ----- Method: SMClient>>ensurePassword (in category 'private') ----- - ensurePassword - self password isEmptyOrNil ifTrue: [ self password: (UIManager default requestPassword: 'Please enter your SqueakMap password.') ]. - self password isEmptyOrNil ifTrue: [ self error: 'authentication failure' ]! Item was removed: - ----- Method: SMClient>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - self username: Utilities authorInitialsPerSe ! Item was removed: - ----- Method: SMClient>>login (in category 'api') ----- - login - | response | - self ensurePassword. - 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 removed: - ----- Method: SMClient>>logout (in category 'private') ----- - logout - ^ (client notNil and: [ client isConnected ]) ifTrue: - [ (self client httpGet: self smUrl , '/account/logout') - content ; - yourself ]! Item was removed: - ----- Method: SMClient>>password (in category 'api') ----- - password - "The SqueakMap user password." - ^ client ifNotNil: [ client password ]! Item was removed: - ----- Method: SMClient>>password: (in category 'api') ----- - password: aString - "The SqueakMap user password." - self client password: aString! Item was removed: - ----- 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 removed: - ----- Method: SMClient>>smUrl (in category 'private') ----- - smUrl - ^ 'http://', SMSqueakMap findServer! Item was removed: - ----- 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 := (Smalltalk at: #WebUtils) multipartBoundary. - fieldMap := {'upload' -> doc}. - ^ (self client - httpPost: self smUrl , '/account/upload' - content: - ((Smalltalk at: #WebUtils) - encodeMultipartForm: fieldMap - boundary: boundary) - type: MIMEDocument contentTypeMultipart , '; boundary=' , boundary - do: [ : req | req headerAt: 'Connection' put: 'keep-alive' ]) - content ; - yourself! Item was removed: - ----- 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 removed: - ----- Method: SMClient>>username (in category 'api') ----- - username - "The SqueakMap username." - ^ client ifNotNil: [ client username ]! Item was removed: - ----- Method: SMClient>>username: (in category 'api') ----- - username: aString - "The SqueakMap username." - self client username: aString! Item was removed: - SystemWindow subclass: #SMLoader - instanceVariableNames: 'packagesList selectedItemWrapper selectedCategoryWrapper filters categoriesToFilterIds' - classVariableNames: 'DefaultCategoriesToFilterIds DefaultFilters' - poolDictionaries: '' - category: 'SMLoader'! - - !SMLoader commentStamp: 'btr 11/30/2006 18:00' prior: 0! - A simple package loader that is currently the standard UI for SqueakMap (the model is an SMSqueakMap instance). - You can open one with: - - SMLoader open! Item was removed: - ----- Method: SMLoader class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^self partName: 'Package Loader' - categories: #(Tools) - documentation: 'SqueakMap UI' - ! Item was removed: - ----- Method: SMLoader class>>initialize (in category 'class initialization') ----- - initialize - "Hook us up in the world menu." - "self initialize" - Smalltalk - at: #ToolBuilder - ifAbsent: [self registerInFlapsRegistry. - (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 removed: - ----- Method: SMLoader class>>initializedInstance (in category 'new-morph participation') ----- - initializedInstance - ^self new createWindow extent: 400 at 400! Item was removed: - ----- Method: SMLoader class>>new (in category 'instance creation') ----- - new - "Create a SqueakMap loader on the default map." - - ^self newOn: SMSqueakMap default! Item was removed: - ----- Method: SMLoader class>>newOn: (in category 'instance creation') ----- - newOn: aMap - "Create a SqueakMap loader on given map." - - ^super new on: aMap; yourself! Item was removed: - ----- Method: SMLoader class>>newStandAlone (in category 'new-morph participation') ----- - newStandAlone - ^self new createWindow! Item was removed: - ----- Method: SMLoader class>>open (in category 'instance creation') ----- - open - "Create and open a SqueakMap Loader." - - "SMLoader open" - - ^self new openAsMorph! Item was removed: - ----- Method: SMLoader class>>openMenuString (in category 'class initialization') ----- - openMenuString - ^ 'SqueakMap Catalog'! Item was removed: - ----- Method: SMLoader class>>openOn: (in category 'instance creation') ----- - openOn: aSqueakMap - "Create and open a SqueakMap Loader on a given map." - - "self openOn: SqueakMap default" - - ^(self newOn: aSqueakMap) openAsMorph! Item was removed: - ----- Method: SMLoader class>>prototypicalToolWindow (in category 'new-morph participation') ----- - prototypicalToolWindow - "Do not update when creating a prototype window (used by flaps etc)" - - ^[self new createWindow; applyModelExtent; yourself] - valueSupplyingAnswers:{ {'*map on disk*'. false}}! Item was removed: - ----- Method: SMLoader class>>registerInFlapsRegistry (in category 'new-morph participation') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry." - - self environment - at: #Flaps - ifPresent: [:cl | (cl respondsTo: #registerQuad:forFlapNamed:) - ifTrue: [cl registerQuad: #(#SMLoader #prototypicalToolWindow 'Package Loader' 'The SqueakMap Package Loader' ) forFlapNamed: 'Tools']]! Item was removed: - ----- Method: SMLoader class>>unload (in category 'class initialization') ----- - unload - (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: - [TheWorldMenu unregisterOpenCommand: self openMenuString]. - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: SMLoader>>addFiltersToMenu: (in category 'menus') ----- - addFiltersToMenu: aMenu - | filterSymbol help | - self filterSpecs do: [:filterArray | - filterSymbol := filterArray second. - help := filterArray third. - aMenu addUpdating: #showFilterString: target: self selector: #toggleFilterState: argumentList: (Array with: filterSymbol). - aMenu balloonTextForLastItem: help]. - aMenu addLine; - addList: #(('Clear all filters' uncheckFilters 'Unchecks all filters to list all packages')) - ! Item was removed: - ----- Method: SMLoader>>addSelectedCategoryAsFilter (in category 'actions') ----- - addSelectedCategoryAsFilter - "Add a new filter that filters on the currently selected category. - Make it enabled as default." - - categoriesToFilterIds add: self selectedCategory id! Item was removed: - ----- Method: SMLoader>>browseCacheDirectory (in category 'interface') ----- - browseCacheDirectory - "Open a FileList2 on the directory for the package or release." - - | item dir win | - item := self selectedPackageOrRelease ifNil: [^ nil]. - item ifNil: [^nil]. - dir := item isPackage - ifTrue: [model cache directoryForPackage: item] - ifFalse: [model cache directoryForPackageRelease: item]. - win := FileList2 morphicViewOnDirectory: dir. " withLabel: item name, ' cache directory'." - win openInWorld - ! Item was removed: - ----- Method: SMLoader>>buildButtonBar (in category 'interface') ----- - buildButtonBar - | aRow btn | - aRow := AlignmentMorph newRow beSticky. - aRow color: Color transparent; - clipSubmorphs: true. - self buttonSpecs do: [:spec | - btn := self buildButtonNamed: spec first helpText: spec third action: spec second. - aRow addMorphBack: btn] - separatedBy: [aRow addTransparentSpacerOfSize: 3 at 0]. - ^ aRow! Item was removed: - ----- Method: SMLoader>>buildButtonNamed:helpText:action: (in category 'interface') ----- - buildButtonNamed: labelText helpText: balloon action: action - | btn | - btn := PluggableButtonMorph on: self getState: nil action: action. - btn color: Color transparent; - hResizing: #shrinkWrap; - vResizing: #spaceFill; - label: labelText; - setBalloonText: balloon; - onColor: Color transparent offColor: Color transparent. - ^ btn! Item was removed: - ----- Method: SMLoader>>buildMorphicCategoriesList (in category 'interface') ----- - buildMorphicCategoriesList - "Create the hierarchical list holding the category tree." - | list | - list := (SimpleHierarchicalListMorph - on: self - list: #categoryWrapperList - selected: #selectedCategoryWrapper - changeSelected: #selectedCategoryWrapper: - menu: #categoriesMenu: - keystroke: nil) autoDeselect: true; - enableDrag: false; - enableDrop: true; - yourself. - list setBalloonText: 'The categories are structured in a tree. Packages and package releases belong to several categories. - You can add one or more categories as filters and enable them in the menu.'. - "list scroller submorphs do:[:each| list expandAll: each]." - list adjustSubmorphPositions. - ^ list! Item was removed: - ----- Method: SMLoader>>buildMorphicPackagesList (in category 'interface') ----- - buildMorphicPackagesList - "Create the hierarchical list holding the packages and releases." - - ^(SimpleHierarchicalListMorph - on: self - list: #packageWrapperList - selected: #selectedItemWrapper - changeSelected: #selectedItemWrapper: - menu: #packagesMenu: - keystroke: nil) - autoDeselect: false; - enableDrag: false; - enableDrop: true; - setBalloonText: 'This shows all packages with their releases that should be displayed according the current filter.'; - yourself! Item was removed: - ----- Method: SMLoader>>buildPackageButtonBar (in category 'interface') ----- - buildPackageButtonBar - | aRow | - "Somewhat patterned after IRCe's buttonRow method." - aRow := AlignmentMorph newRow beSticky. - aRow color: Color transparent; - clipSubmorphs: true. - ^ aRow! Item was removed: - ----- Method: SMLoader>>buildPackagePane (in category 'interface') ----- - buildPackagePane - "Create the text area to the right in the loader." - - | ptm | - ptm := PluggableTextMorph - on: self - text: #contents - accept: nil - readSelection: nil "#packageSelection " - menu: nil. - ptm setBalloonText: 'This is where the selected package or package release is displayed.'. - ptm lock. - ^ptm! Item was removed: - ----- Method: SMLoader>>buildSearchPane (in category 'interface') ----- - buildSearchPane - "Cribbed from MessageNames>>inMorphicWindowWithInitialSearchString:" - | typeInView searchButton typeInPane | - typeInView := PluggableTextMorph - on: self - text: nil - accept: #findPackage:notifying: - readSelection: nil - menu: nil. - typeInView acceptOnCR: true; - vResizing: #spaceFill; - hResizing: #spaceFill; - setTextMorphToSelectAllOnMouseEnter; - askBeforeDiscardingEdits: false; - setProperty: #alwaysAccept toValue: true. - (typeInView respondsTo: #hideScrollBarsIndefinitely) - ifTrue: [typeInView hideScrollBarsIndefinitely] - ifFalse: [typeInView hideScrollBarIndefinitely]. - searchButton := SimpleButtonMorph new target: typeInView; - color: Color white; - label: 'Search'; - actionSelector: #accept; - arguments: #(); yourself. - typeInPane := AlignmentMorph newRow. - typeInPane vResizing: #shrinkWrap; - hResizing: #shrinkWrap; - listDirection: #leftToRight; - addMorphFront: searchButton; - addTransparentSpacerOfSize: 6 @ 0; - addMorphBack: typeInView; - setBalloonText: 'Type into the pane, then press Search (or hit RETURN) to visit the next package matching what you typed.'. - ^ typeInPane! Item was removed: - ----- Method: SMLoader>>buttonSpecs (in category 'interface') ----- - buttonSpecs - ^ #(('Install' installPackageRelease 'Install the latest version from the server.') - ('Email' emailPackageMaintainers 'Open an editor to send an email to the owner and co-maintainers of this package.') - ('Browse cache' browseCacheDirectory 'Browse cache directory of the selection.') - ('Update' loadUpdates 'Update the package index from the servers.') - ('Upgrade All' upgradeInstalledPackagesConfirm 'Upgrade all installed packages (confirming each).') - ('Help' help 'What is this?'))! Item was removed: - ----- Method: SMLoader>>cachePackageReleaseAndOfferToCopy (in category 'actions') ----- - cachePackageReleaseAndOfferToCopy - "Cache package release, then offer to copy it somewhere. - Answer the chosen file's location after copy, - or the cache location if no directory was chosen." - - | release installer newDir newName newFile oldFile oldName | - release := self selectedPackageOrRelease. - release isPackageRelease ifFalse: [ self error: 'Should be a package release!!']. - installer := SMInstaller forPackageRelease: release. - [Cursor wait showWhile: [installer cache]] on: Error do: [:ex | - | msg | - msg := ex messageText ifNil: [ex asString]. - self informException: ex msg: ('Error occurred during download:\', msg, '\') withCRs. - ^nil ]. - installer isCached ifFalse: [self inform: 'Download failed, see transcript for details'. ^nil]. - oldName := installer fullFileName. - newDir := UIManager default chooseDirectoryFrom: installer directory. - newDir ifNil: [ ^oldName ]. - newDir = installer directory ifTrue: [ ^oldName ]. - newName := newDir fullNameFor: installer fileName. - newFile := FileStream newFileNamed: newName. - newFile ifNil: [ ^oldName ]. - newFile binary. - oldFile := FileStream readOnlyFileNamed: oldName. - oldFile ifNil: [ ^nil ]. - oldFile binary. - [[ newDir copyFile: oldFile toFile: newFile ] ensure: [ oldFile close. newFile close ]] on: Error do: [ :ex | ^oldName ]. - ^newName! Item was removed: - ----- Method: SMLoader>>categoriesMenu: (in category 'menus') ----- - categoriesMenu: aMenu - "Answer the categories-list menu." - - self selectedCategory - ifNotNil: [aMenu addList: self categorySpecificOptions; addLine]. - aMenu addList: self generalOptions. - self addFiltersToMenu: aMenu. - ^aMenu! Item was removed: - ----- Method: SMLoader>>categorySpecificOptions (in category 'menus') ----- - categorySpecificOptions - | choices | - choices := OrderedCollection new. - (categoriesToFilterIds includes: self selectedCategory id) - ifTrue: [ - choices add: #('Remove filter' #removeSelectedCategoryAsFilter 'Remove the filter for the selected category.')] - ifFalse: [ - choices add: #('Add as filter' #addSelectedCategoryAsFilter 'Add the selection as a filter to hide unrelated packages.')]. - categoriesToFilterIds isEmpty ifFalse: [ - choices add: #('Remove all filters' #removeCategoryFilters 'Remove all category filters.')]. - ^ choices! Item was removed: - ----- Method: SMLoader>>categoryWrapperList (in category 'lists') ----- - categoryWrapperList - "Create the wrapper list for the hierarchical list. - We sort the categories by name but ensure that 'Squeak versions' - is first if it exists." - | list first | - list := (model categories - select: [:each | each parent isNil]) asArray - sort: [:c1 :c2 | c1 name <= c2 name]. - first := list - detect: [:any | any name = 'Squeak versions'] - ifNone: []. - first - ifNotNil: [list := list copyWithout: first. - list := {first} , list]. - ^ list - collect: [:cat | SMCategoryWrapper with: cat model: self]! Item was removed: - ----- Method: SMLoader>>changeFilters: (in category 'filter utilities') ----- - changeFilters: anObject - "Update my selection." - - | oldItem index | - oldItem := self selectedPackageOrRelease. - filters := anObject. - self packagesListIndex: ((index := self packageList indexOf: oldItem) - ifNil: [0] - ifNotNil: [index]). - self noteChanged! Item was removed: - ----- Method: SMLoader>>contents (in category 'private') ----- - contents - | packageOrRelease | - packageOrRelease := self selectedPackageOrRelease. - ^packageOrRelease - ifNil: ['<No package selected>'] - ifNotNil: [packageOrRelease fullDescription] - ! Item was removed: - ----- Method: SMLoader>>createNewRelease (in category 'private') ----- - createNewRelease - SMReleaseBrowser - openOn: self selectedItem newUnattachedRelease initializeMandatoryCategories ; - yourself! Item was removed: - ----- Method: SMLoader>>createWindow (in category 'interface') ----- - createWindow - | buttonBarHeight searchHeight vertDivide horizDivide | - buttonBarHeight := 0.07. - searchHeight := 0.07. - vertDivide := 0.3. - horizDivide := 0.6. - self addMorph: (self buildButtonBar borderWidth: 0) - frame: (0.0 @ 0.0 corner: 1.0 @ buttonBarHeight). - self addMorph: (self buildSearchPane borderWidth: 0) - frame: (0.0 @ buttonBarHeight corner: vertDivide @ searchHeight). - self addMorph: (self buildMorphicPackagesList borderWidth: 0) - frame: (0.0 @ (buttonBarHeight + searchHeight) corner: vertDivide @ horizDivide). - self addMorph: (self buildMorphicCategoriesList borderWidth: 0) - frame: (0.0 @ horizDivide corner: vertDivide @ 1.0). - self addMorph: (self buildPackagePane borderWidth: 0) - frame: (vertDivide @ buttonBarHeight corner: 1.0 @ 1.0). - self on: #mouseEnter send: #paneTransition: to: self. - self on: #mouseLeave send: #paneTransition: to: self. - self paneColor: self color.! Item was removed: - ----- Method: SMLoader>>defaultColor (in category 'user interface') ----- - defaultColor - - ^ self defaultWindowColor! Item was removed: - ----- Method: SMLoader>>defaultLabel (in category 'interface') ----- - defaultLabel - ^'SqueakMap Package Loader'! Item was removed: - ----- Method: SMLoader>>defaultWindowColor (in category 'user interface') ----- - defaultWindowColor - ^ (Color r: 0.801 g: 0.801 b: 0.614)! Item was removed: - ----- Method: SMLoader>>downloadPackageRelease (in category 'actions') ----- - downloadPackageRelease - "Force a download of the selected package release into the cache." - - | release | - release := self selectedPackageOrRelease. - release isPackageRelease ifFalse: [ self error: 'Should be a package release!!']. - [Cursor wait showWhile: [ - (SMInstaller forPackageRelease: release) download] - ] on: Error do: [:ex | - | msg | - msg := ex messageText ifNil: [ex asString]. - self informException: ex msg: ('Error occurred during download:\', msg, '\') withCRs]! Item was removed: - ----- Method: SMLoader>>emailPackageMaintainers (in category 'actions') ----- - emailPackageMaintainers - "Send mail to package owner and co-maintainers." - - | item package toAddresses | - item := self selectedPackageOrRelease ifNil: [^ nil]. - package := item isPackageRelease ifTrue: [item package] ifFalse: [item]. - - "(this logic should be moved to MailMessage as soon as it can handle - multiple To: addresses)" - toAddresses := '<', package owner email, '>'. - package maintainers ifNotNil: [ - package maintainers do: [:maintainer | - toAddresses := toAddresses, ', <', maintainer email, '>']]. - - SMUtilities sendMailTo: toAddresses regardingPackageRelease: item! Item was removed: - ----- Method: SMLoader>>filterAdd: (in category 'filter utilities') ----- - filterAdd: anObject - - self changeFilters: (self filters copyWith: anObject) - ! Item was removed: - ----- Method: SMLoader>>filterAutoInstall (in category 'filters') ----- - filterAutoInstall - ^[:package | package isInstallable]! Item was removed: - ----- Method: SMLoader>>filterAvailable (in category 'filters') ----- - filterAvailable - - ^[:package | package isAvailable]! Item was removed: - ----- Method: SMLoader>>filterInstalled (in category 'filters') ----- - filterInstalled - ^[:package | package isInstalled]! Item was removed: - ----- Method: SMLoader>>filterNotInstalledYet (in category 'filters') ----- - filterNotInstalledYet - ^[:package | package isInstalled not]! Item was removed: - ----- Method: SMLoader>>filterNotUptoDate (in category 'filters') ----- - filterNotUptoDate - - ^[:package | package isAvailable]! Item was removed: - ----- Method: SMLoader>>filterPublished (in category 'filters') ----- - filterPublished - ^[:package | package isPublished]! Item was removed: - ----- Method: SMLoader>>filterRemove: (in category 'filter utilities') ----- - filterRemove: anObject - - self changeFilters: (self filters copyWithout: anObject) - ! Item was removed: - ----- Method: SMLoader>>filterSafelyAvailable (in category 'filters') ----- - filterSafelyAvailable - - ^[:package | package isSafelyAvailable]! Item was removed: - ----- Method: SMLoader>>filterSpecs (in category 'filter utilities') ----- - filterSpecs - "Return a specification for the filter menu. Is called each time." - - | specs | - specs := #( - #('Auto-installable packages' #filterAutoInstall 'display only packages that can be installed automatically') - #('New available packages' #filterAvailable 'display only packages that are not installed or that have newer releases available.') - #('New safely-available packages' #filterSafelyAvailable 'display only packages that are not installed or that have newer releases available that are safe to install, meaning that they are published and meant for the current version of Squeak.') - #('Installed packages' #filterInstalled 'Display only packages that are installed.') - #('Published packages' #filterPublished 'Display only packages that have at least one published release.')) - asOrderedCollection. - categoriesToFilterIds do: [:catId | - specs add: {'Packages in ', (model object: catId) name. catId. 'Display only packages that are in the category.'}]. - ^ specs! Item was removed: - ----- Method: SMLoader>>filterVersion (in category 'filters') ----- - filterVersion - "Ignore spaces in the version string, they're sometimes spurious. - - Not used anymore." - - ^[:package | package categories anySatisfy: - [:cat | (cat name, '*') match: (Smalltalk version copyWithout: $ ) ]]! Item was removed: - ----- Method: SMLoader>>filters (in category 'filter utilities') ----- - filters - ^filters! Item was removed: - ----- Method: SMLoader>>findPackage:notifying: (in category 'actions') ----- - findPackage: aString notifying: aView - "Search and select a package with the given (sub) string in the name or description." - | index list match descriptions | - match := aString asString asLowercase. - index := self packagesListIndex. - list := self packageNameList. - list isEmpty ifTrue: [^self]. - descriptions := self packageWrapperList collect: [:e | e withoutListWrapper description]. - index + 1 to: list size - do: - [:i | - (((list at: i) includesSubstring: match caseSensitive: false) or: - [(descriptions at: i) includesSubstring: match caseSensitive: false]) - ifTrue: [^self packagesListIndex: i]]. - "wrap around" - 1 to: index - do: - [:i | - (((list at: i) includesSubstring: match caseSensitive: false) or: - [(descriptions at: i) includesSubstring: match caseSensitive: false]) - ifTrue: [^self packagesListIndex: i]]. - self inform: 'No package matching ' , aString asString! Item was removed: - ----- Method: SMLoader>>generalOptions (in category 'menus') ----- - generalOptions - ^#( #('Upgrade all installed packages' upgradeInstalledPackagesNoConfirm) - #('Upgrade all installed packages confirming each' upgradeInstalledPackagesConfirm) - #('Put list in paste buffer' listInPasteBuffer) - #('Save filters as default' saveFiltersAsDefault) - #- ) - - ! Item was removed: - ----- Method: SMLoader>>help (in category 'interface') ----- - help - "Present help text. If there is a web server available, offer to open it. - Use the WebBrowser registry if possible, or Scamper if available." - | message browserClass | - message := 'Welcome to the SqueakMap package loader. - The names of packages are followed by (installed version -> latest version). - If there is no arrow, your installed version of the package is the latest. - Installed packages and releases are also in bold. - The checkbox menu items at the bottom let you modify which packages - you''ll see. Take a look at them - only some packages are shown initially. - The options available for a package depend on how it was packaged. - If you like a package or have comments on it, please contact - the author or the squeak mailing list.'. - - browserClass := Smalltalk at: #WebBrowser ifPresent: [ :registry | registry default ]. - browserClass := browserClass ifNil: [ Smalltalk at: #Scamper ifAbsent: [ ^self inform: message ]]. - - (self confirm: message, ' - Would you like to view more detailed help on the SqueakMap swiki page?') - ifTrue: [ browserClass openOnUrl: 'http://wiki.squeak.org/squeak/2726' asUrl]! Item was removed: - ----- Method: SMLoader>>informException:msg: (in category 'private') ----- - informException: ex msg: msg - "Tell the user that an error has occurred. - Offer to open debug notifier." - - (self confirm: msg, 'Would you like to open a debugger?') - ifTrue: [ex pass]! Item was removed: - ----- Method: SMLoader>>installPackageRelease (in category 'actions') ----- - installPackageRelease - "Install selected package or release. - The cache is used." - | item release | - item := self selectedPackageOrRelease - ifNil: [^ nil]. - item isPackageRelease - ifTrue: [^ self installPackageRelease: item] - ifFalse: [release := item lastReleaseForCurrentSystemVersion. - release - ifNil: [(self confirm: 'The package has no published release for your Squeak version, try releases for any Squeak version?') - ifTrue: [release := item lastPublishedRelease. - release - ifNil: [(self confirm: 'The package has no published release at all, take the latest of the unpublished releases?') - ifTrue: [release := item lastRelease]]]]. - release - ifNotNil: [^ self installPackageRelease: release]]! Item was removed: - ----- Method: SMLoader>>installPackageRelease: (in category 'private') ----- - installPackageRelease: aRelease - "Install a package release. The cache is used." - - | myRelease | - aRelease isCompatibleWithCurrentSystemVersion ifFalse: - [(self confirm: - 'The package you are about to install is not listed as - being compatible with your image version (', SystemVersion current majorMinorVersion, '), - so the package may not work properly. - Do you still want to proceed with the install?') - ifFalse: [^ self]]. - myRelease := self installedReleaseOfMe. - [Cursor wait showWhile: [ - (SMInstaller forPackageRelease: aRelease) install. - myRelease = self installedReleaseOfMe - ifFalse: [self reOpen] - ifTrue: [self noteChanged]] - ] on: Error do: [:ex | - | msg | - msg := ex messageText ifNil:[ex asString]. - self informException: ex msg: ('Error occurred during install:\', msg, '\') withCRs].! Item was removed: - ----- Method: SMLoader>>installPackageWithDependents: (in category 'actions') ----- - installPackageWithDependents: package - - | myRelease | - myRelease := self installedReleaseOfMe. - [Cursor wait showWhile: [ - package installWithDependencies. - myRelease = self installedReleaseOfMe ifFalse: [self reOpen]. - self noteChanged] - ] on: Error do: [:ex | - | msg | - msg := ex messageText ifNil:[ex asString]. - self informException: ex msg: ('Error occurred during install:\', msg, '\') withCRs].! Item was removed: - ----- Method: SMLoader>>installedReleaseOfMe (in category 'private') ----- - installedReleaseOfMe - "Return the release of the installed package loader." - - ^SMSqueakMap default installedReleaseOf: (SMSqueakMap default packageWithId: '941c0108-4039-4071-9863-a8d7d2b3d4a3').! Item was removed: - ----- Method: SMLoader>>labelForFilter: (in category 'filter utilities') ----- - labelForFilter: aFilterSymbol - ^(self filterSpecs detect: [:fs | fs second = aFilterSymbol]) first! Item was removed: - ----- Method: SMLoader>>listInPasteBuffer (in category 'actions') ----- - listInPasteBuffer - "Useful when talking with people etc. - Uses the map to produce a nice String." - - Clipboard clipboardText: - (String streamContents: [:s | - packagesList do: [:p | - s nextPutAll: p nameWithVersionLabel; cr ]]) asText! Item was removed: - ----- Method: SMLoader>>loadUpdates (in category 'actions') ----- - loadUpdates - [Cursor wait showWhile: [ - model loadUpdates. - self noteChanged ] - ] on: Error do: [:ex | - self informException: ex msg: ('Error occurred when updating map:\', ex messageText, '\') withCRs]! Item was removed: - ----- Method: SMLoader>>noteChanged (in category 'private') ----- - noteChanged - filters ifNil: [^self reOpen]. - model ifNotNil: [ - packagesList := nil. - selectedCategoryWrapper := nil. - self changed: #categoryWrapperList. - self changed: #packageWrapperList. - self changed: #packagesListIndex. "update my selection" - self contentsChanged]! Item was removed: - ----- Method: SMLoader>>on: (in category 'initialization') ----- - on: aSqueakMap - "Initialize instance." - model := aSqueakMap. - model synchWithDisk. - filters := DefaultFilters copy. - categoriesToFilterIds := DefaultCategoriesToFilterIds copy! Item was removed: - ----- Method: SMLoader>>openAsMorph (in category 'initialization') ----- - openAsMorph - "Open the loader as a Morphic window." - "SMLoader new openAsMorph" - - ^self createWindow openInWorld! Item was removed: - ----- Method: SMLoader>>package:filteredByCategory: (in category 'filter utilities') ----- - package: aPackage filteredByCategory: aCategory - "Answer true if the package should be shown - if we filter on <aCategory>. It should be shown - if itself or any of its releases has the category." - - | releases | - releases := aPackage releases. - ^(aPackage hasCategoryOrSubCategoryOf: aCategory) or: [ - releases anySatisfy: [:rel | - rel hasCategoryOrSubCategoryOf: aCategory]]! Item was removed: - ----- Method: SMLoader>>packageList (in category 'lists') ----- - packageList - "Return a list of the SMPackages that should be visible - by applying all the filters. Also filter based on the currently - selected category - if any." - - | list selectedCategory | - list := packagesList ifNil: [ - packagesList := self packages select: [:p | - (filters ifNil: [#()]) allSatisfy: [:currFilter | - currFilter isSymbol - ifTrue: [(self perform: currFilter) value: p] - ifFalse: [ - self package: p - filteredByCategory: (model object: currFilter)]]]]. - selectedCategoryWrapper ifNotNil: - [selectedCategory := selectedCategoryWrapper category. - list := list select: [:each | self package: each filteredByCategory: selectedCategory]]. - self updateLabel: list. - ^list! Item was removed: - ----- Method: SMLoader>>packageNameList (in category 'lists') ----- - packageNameList - ^self packageWrapperList collect: [:e | e withoutListWrapper name]! Item was removed: - ----- 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' ) ]. - choices add: self buttonSpecs second. - ^ choices! Item was removed: - ----- Method: SMLoader>>packageWrapperList (in category 'lists') ----- - packageWrapperList - "Return the list with each element wrapped so that it - can be used in a SimpleHierarchicalListMorph." - - ^self packageList collect: [:e | SMPackageWrapper with: e]! Item was removed: - ----- Method: SMLoader>>packages (in category 'private') ----- - packages - "We request the packages as sorted by name by default." - - ^model packagesByName asArray - ! Item was removed: - ----- Method: SMLoader>>packagesListIndex (in category 'accessing') ----- - packagesListIndex - ^self packageWrapperList indexOf: self selectedItemWrapper! Item was removed: - ----- Method: SMLoader>>packagesListIndex: (in category 'accessing') ----- - packagesListIndex: anObject - self - selectedItemWrapper: (anObject ifNotNil: [anObject = 0 - ifFalse: [self packageWrapperList at: anObject]])! Item was removed: - ----- Method: SMLoader>>packagesMenu: (in category 'menus') ----- - packagesMenu: aMenu - "Answer the packages-list menu." - - self selectedPackageOrRelease - ifNotNil: [aMenu addList: self packageSpecificOptions; addLine]. - aMenu addList: self generalOptions. - self addFiltersToMenu: aMenu. - ^aMenu! Item was removed: - ----- Method: SMLoader>>reOpen (in category 'private') ----- - reOpen - "Close this package loader, probably because it has been updated, - and open a new one." - self inform: 'This package loader has been upgraded and will be closed and reopened to avoid strange side effects.'. - self delete. - (Smalltalk at: self class name) open! Item was removed: - ----- Method: SMLoader>>removeCategoryFilters (in category 'actions') ----- - removeCategoryFilters - "Remove all category filters." - - categoriesToFilterIds := OrderedCollection new! Item was removed: - ----- Method: SMLoader>>removeSelectedCategoryAsFilter (in category 'actions') ----- - removeSelectedCategoryAsFilter - "Remove the filter that filters on the currently selected category." - - categoriesToFilterIds remove: self selectedCategory id! Item was removed: - ----- Method: SMLoader>>saveFiltersAsDefault (in category 'actions') ----- - saveFiltersAsDefault - "Save the current filters as default so that they - are selected the next time the loader is opened." - - DefaultFilters := filters copy. - DefaultCategoriesToFilterIds := categoriesToFilterIds copy! Item was removed: - ----- Method: SMLoader>>selectedCategory (in category 'accessing') ----- - selectedCategory - "Return selected category." - ^selectedCategoryWrapper ifNotNil: [:w | w withoutListWrapper]! Item was removed: - ----- Method: SMLoader>>selectedCategoryWrapper (in category 'accessing') ----- - selectedCategoryWrapper - ^selectedCategoryWrapper! Item was removed: - ----- Method: SMLoader>>selectedCategoryWrapper: (in category 'accessing') ----- - selectedCategoryWrapper: aWrapper - selectedCategoryWrapper := aWrapper. - (aWrapper notNil and: - [aWrapper withoutListWrapper objects includes: selectedItemWrapper withoutListWrapper]) - ifFalse: [self selectedItemWrapper: nil]. - self changed: #selectedCategoryWrapper. - self changed: #packageWrapperList.! Item was removed: - ----- Method: SMLoader>>selectedItemWrapper (in category 'accessing') ----- - selectedItemWrapper - ^selectedItemWrapper! Item was removed: - ----- Method: SMLoader>>selectedItemWrapper: (in category 'accessing') ----- - selectedItemWrapper: aWrapper - selectedItemWrapper := aWrapper. - self changed: #selectedItemWrapper. - self contentsChanged! Item was removed: - ----- Method: SMLoader>>selectedPackageOrRelease (in category 'private') ----- - selectedPackageOrRelease - "Return selected package or package release." - - ^self selectedItemWrapper ifNotNil: [:w | w withoutListWrapper]! Item was removed: - ----- Method: SMLoader>>showFilterString: (in category 'filter utilities') ----- - showFilterString: aFilterSymbol - ^(self stateForFilter: aFilterSymbol), (self labelForFilter: aFilterSymbol)! Item was removed: - ----- Method: SMLoader>>stateForFilter: (in category 'filter utilities') ----- - stateForFilter: aFilterSymbol - ^(self filters includes: aFilterSymbol) ifTrue: ['<yes>'] ifFalse: ['<no>'] - - ! Item was removed: - ----- Method: SMLoader>>toggleFilterState: (in category 'filter utilities') ----- - toggleFilterState: aFilterSymbol - - ^(self filters includes: (aFilterSymbol)) - ifTrue: [self filterRemove: aFilterSymbol] - ifFalse: [self filterAdd: aFilterSymbol]! Item was removed: - ----- Method: SMLoader>>uncheckFilters (in category 'actions') ----- - uncheckFilters - "Uncheck all filters." - - filters := OrderedCollection new. - self noteChanged! Item was removed: - ----- Method: SMLoader>>updateLabel: (in category 'interface') ----- - updateLabel: packagesShown - "Update the label of the window." - - self setLabel: self defaultLabel , ' (', - (packagesShown size < model packages size ifTrue: [packagesShown size printString, - ' shown out of '] ifFalse: ['']) , model packages size printString, ' packages)'! Item was removed: - ----- Method: SMLoader>>upgradeInstalledPackages (in category 'actions') ----- - upgradeInstalledPackages - "Tries to upgrade all installed packages to the latest published release for this - version of Squeak. So this is a conservative approach." - - | installed old myRelease toUpgrade info | - installed := model installedPackages. - old := model oldPackages. - old isEmpty ifTrue: [ - ^self inform: 'All ', installed size printString, ' installed packages are up to date.']. - toUpgrade := model upgradeableAndOldPackages. - toUpgrade isEmpty ifTrue: [ - ^self inform: 'None of the ', old size printString, ' old packages of the ', installed size printString, ' installed can be automatically upgraded. You need to upgrade them manually.']. - info := old size < toUpgrade size ifTrue: [ - 'Of the ', old size printString, ' old packages only ', toUpgrade size printString, ' can be upgraded. - The following packages will not be upgraded: - ', (String streamContents: [:s | (old removeAll: toUpgrade; yourself) - do: [:p | s nextPutAll: p nameWithVersionLabel; cr]])] - ifFalse: ['All old packages upgradeable.']. - (self confirm: info, ' - About to upgrade the following packages: - ', (String streamContents: [:s | toUpgrade do: [:p | s nextPutAll: p nameWithVersionLabel; cr]]), 'Proceed?') ifTrue: [ - myRelease := self installedReleaseOfMe. - [Cursor wait showWhile: [ - model upgradeOldPackages. - self inform: toUpgrade size printString, ' packages successfully upgraded.'. - myRelease = self installedReleaseOfMe - ifFalse: [self reOpen] - ifTrue: [self noteChanged]] - ] on: Error do: [:ex | - self informException: ex msg: ('Error occurred when upgrading old packages:\', ex messageText, '\') withCRs]]! Item was removed: - ----- Method: SMLoader>>upgradeInstalledPackagesConfirm (in category 'actions') ----- - upgradeInstalledPackagesConfirm - "Tries to upgrade all installed packages to the latest published release for this - version of Squeak. Confirms on each upgrade." - - ^ self upgradeInstalledPackagesConfirm: true! Item was removed: - ----- Method: SMLoader>>upgradeInstalledPackagesConfirm: (in category 'private') ----- - upgradeInstalledPackagesConfirm: confirmEach - "Tries to upgrade all installed packages to the latest published release for this - version of Squeak. If confirmEach is true we ask for every upgrade." - - | installed old myRelease toUpgrade info | - installed := model installedPackages. - old := model oldPackages. - old isEmpty ifTrue: [ - ^self inform: 'All ', installed size printString, ' installed packages are up to date.']. - toUpgrade := model upgradeableAndOldPackages. - toUpgrade isEmpty ifTrue: [ - ^self inform: 'None of the ', old size printString, ' old packages of the ', installed size printString, ' installed can be automatically upgraded. You need to upgrade them manually.']. - info := old size < toUpgrade size ifTrue: [ - 'Of the ', old size printString, ' old packages only ', toUpgrade size printString, ' can be upgraded. - The following packages will not be upgraded: - ', (String streamContents: [:s | (old removeAll: toUpgrade; yourself) - do: [:p | s nextPutAll: p nameWithVersionLabel; cr]])] - ifFalse: ['All old packages upgradeable.']. - (self confirm: info, ' - About to upgrade the following packages: - ', (String streamContents: [:s | toUpgrade do: [:p | s nextPutAll: p nameWithVersionLabel; cr]]), 'Proceed?') ifTrue: [ - myRelease := self installedReleaseOfMe. - [Cursor wait showWhile: [ - confirmEach ifTrue: [ - model upgradeOldPackagesConfirmBlock: [:p | - self confirm: 'Upgrade ', p installedRelease packageNameWithVersion, ' to ', - (p lastPublishedReleaseForCurrentSystemVersionNewerThan: p installedRelease) listName, '?']] - ifFalse: [model upgradeOldPackages]. - self inform: toUpgrade size printString, ' packages successfully processed.'. - myRelease = self installedReleaseOfMe - ifFalse: [self reOpen] - ifTrue: [self noteChanged]] - ] on: Error do: [:ex | - self informException: ex msg: ('Error occurred when upgrading old packages:\', ex messageText, '\') withCRs]]! Item was removed: - ----- Method: SMLoader>>upgradeInstalledPackagesNoConfirm (in category 'actions') ----- - upgradeInstalledPackagesNoConfirm - "Tries to upgrade all installed packages to the latest published release for this - version of Squeak. No confirmation on each upgrade." - - ^ self upgradeInstalledPackagesConfirm: false! Item was removed: - SMLoader subclass: #SMLoaderCategorical - instanceVariableNames: 'currentPackageList packagesListIndex' - classVariableNames: '' - poolDictionaries: '' - category: 'SMLoader'! - - !SMLoaderCategorical commentStamp: 'btr 12/1/2006 15:16' prior: 0! - A variant package loader that uses a more-or-less standard Smalltalk-80 browser perspective of selecting categories in one pane and then selecting items within in the next pane. - You can open one with: - - SMLoaderCategorical open! Item was removed: - ----- Method: SMLoaderCategorical class>>initialize (in category 'menu registration') ----- - initialize - Smalltalk at: #ToolBuilder ifAbsent: [ - (TheWorldMenu respondsTo: #registerOpenCommand:) - ifTrue: [TheWorldMenu registerOpenCommand: {self openMenuString. {self. #open}}]]! Item was removed: - ----- Method: SMLoaderCategorical class>>openMenuString (in category 'menu registration') ----- - openMenuString - ^ 'SqueakMap Categories'! Item was removed: - ----- Method: SMLoaderCategorical class>>removeFromSystem (in category 'menu registration') ----- - removeFromSystem - (TheWorldMenu respondsTo: #registerOpenCommand:) - ifTrue: [TheWorldMenu unregisterOpenCommand: self openMenuString]. - self removeFromSystem: true! Item was removed: - ----- Method: SMLoaderCategorical class>>unload (in category 'menu registration') ----- - unload - (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: - [TheWorldMenu unregisterOpenCommand: self openMenuString].! Item was removed: - ----- Method: SMLoaderCategorical>>buildMorphicInstalledPackagesList (in category 'interface') ----- - buildMorphicInstalledPackagesList - | list | - (list := PluggableListMorph new) - on: self - list: #installedPackageNameList - selected: #installedPackagesListIndex - changeSelected: #installedPackagesListIndex: - menu: #packagesMenu: - keystroke: #packagesListKey:from:. - ^ list! Item was removed: - ----- Method: SMLoaderCategorical>>buildMorphicNotInstalledPackagesList (in category 'interface') ----- - buildMorphicNotInstalledPackagesList - | list | - (list := PluggableListMorph new) - on: self - list: #notInstalledPackageNameList - selected: #notInstalledPackagesListIndex - changeSelected: #notInstalledPackagesListIndex: - menu: #packagesMenu: - keystroke: #packagesListKey:from:. - ^ list! Item was removed: - ----- Method: SMLoaderCategorical>>createFancyWindow (in category 'interface') ----- - createFancyWindow - "Creates a variant of the window where the package pane is split between installed and uninstalled packages." - | buttonBarHeight searchHeight vertDivide horizDivide | - buttonBarHeight := 0.07. - searchHeight := 0.07. - vertDivide := 0.5. - horizDivide := 0.6. - self addMorph: (self buildButtonBar borderWidth: 0) - frame: (0 @ 0 corner: 1 @ buttonBarHeight). - self addMorph: (self buildSearchPane borderWidth: 0) - frame: (0 @ buttonBarHeight corner: vertDivide @ searchHeight). - self addMorph: (self buildMorphicCategoriesList borderWidth: 0) - frame: (0 @ (buttonBarHeight + searchHeight) corner: vertDivide @ horizDivide). - self addMorph: (self buildMorphicNotInstalledPackagesList borderWidth: 0) - frame: (vertDivide @ buttonBarHeight corner: 1 @ (horizDivide / 2)). - self addMorph: (self buildMorphicInstalledPackagesList borderWidth: 0) - frame: (vertDivide @ (horizDivide / 2) corner: 1 @ horizDivide). - self addMorph: (self buildPackagePane borderWidth: 0) - frame: (0 @ horizDivide corner: 1 @ 1). - self on: #mouseEnter send: #paneTransition: to: self. - self on: #mouseLeave send: #paneTransition: to: self. - self setUpdatablePanesFrom: #(#installedPackageNameList #notInstalledPackageNameList ). - currentPackageList := #notInstalled. - self setLabel: self defaultLabel! Item was removed: - ----- Method: SMLoaderCategorical>>createWindow (in category 'interface') ----- - createWindow - | buttonBarHeight searchHeight vertDivide horizDivide | - buttonBarHeight := 0.07. - searchHeight := 0.07. - vertDivide := 0.5. - horizDivide := 0.6. - self addMorph: (self buildButtonBar borderWidth: 0) - frame: (0 @ 0 corner: 1 @ buttonBarHeight). - self addMorph: (self buildMorphicCategoriesList borderWidth: 0) - frame: (0 @ buttonBarHeight corner: vertDivide @ horizDivide). - self addMorph: (self buildSearchPane borderWidth: 0) - frame: (vertDivide @ buttonBarHeight corner: 1 @ (buttonBarHeight + searchHeight)). - self addMorph: (self buildMorphicPackagesList borderWidth: 0) - frame: (vertDivide @ (buttonBarHeight + searchHeight) corner: 1 @ horizDivide). - self addMorph: (self buildPackagePane borderWidth: 0) - frame: (0 @ horizDivide corner: 1 @ 1). - self on: #mouseEnter send: #paneTransition: to: self. - self on: #mouseLeave send: #paneTransition: to: self. - self setLabel: self defaultLabel. - self paneColor: self color.! Item was removed: - ----- Method: SMLoaderCategorical>>currentPackageList (in category 'accessing') ----- - currentPackageList - ^currentPackageList! Item was removed: - ----- Method: SMLoaderCategorical>>currentPackageList: (in category 'accessing') ----- - currentPackageList: aSymbol - currentPackageList := aSymbol. - self changed: #installButtonLabel.! Item was removed: - ----- Method: SMLoaderCategorical>>defaultLabel (in category 'interface') ----- - defaultLabel - ^ 'SqueakMap Categorical Package Loader'! Item was removed: - ----- Method: SMLoaderCategorical>>installButtonLabel (in category 'interface') ----- - installButtonLabel - ^ self currentPackageList = #notInstalled - ifTrue: ['Install the above package'] - ifFalse: ['Remove the above package']! Item was removed: - ----- Method: SMLoaderCategorical>>installedPackageNameList (in category 'lists') ----- - installedPackageNameList - ^self packageList select: [:e | e isInstalled]! Item was removed: - ----- Method: SMLoaderCategorical>>installedPackagesListIndex (in category 'accessing') ----- - installedPackagesListIndex - self currentPackageList = #installed - ifTrue: [^ self packagesListIndex] - ifFalse: [^ 0]! Item was removed: - ----- Method: SMLoaderCategorical>>installedPackagesListIndex: (in category 'accessing') ----- - installedPackagesListIndex: anObject - packagesListIndex := anObject. - self currentPackageList ~= #installed - ifTrue: [self currentPackageList: #installed. - self changed: #currentPackageList]. - self noteChanged! Item was removed: - ----- Method: SMLoaderCategorical>>isOn (in category 'accessing') ----- - isOn - ^false! Item was removed: - ----- Method: SMLoaderCategorical>>notInstalledPackageNameList (in category 'lists') ----- - notInstalledPackageNameList - ^self packageList select: [:e | e isInstalled not]! Item was removed: - ----- Method: SMLoaderCategorical>>notInstalledPackagesListIndex (in category 'accessing') ----- - notInstalledPackagesListIndex - self currentPackageList = #notInstalled - ifTrue: [^ self packagesListIndex] - ifFalse: [^ 0]! Item was removed: - ----- Method: SMLoaderCategorical>>notInstalledPackagesListIndex: (in category 'accessing') ----- - notInstalledPackagesListIndex: anObject - packagesListIndex := anObject. - self currentPackageList ~= #notInstalled ifTrue: - [self currentPackageList: #notInstalled. - self changed: #currentPackageList]. - self changed: #packagesListIndex. - "update my selection" - self noteChanged. - self contentsChanged! Item was removed: - ----- Method: SMLoaderCategorical>>noteChanged (in category 'private') ----- - noteChanged - self changed: #installedPackageNameList. - self changed: #notInstalledPackageNameList. - super noteChanged." - self changed: #packageNameList. - self changed: #packagesListIndex. - self changed: #categoriesForPackage. - self contentsChanged."! Item was removed: - ----- Method: SMLoaderCategorical>>packageList (in category 'lists') ----- - packageList - ^ self packages - select: [:e | (e categories - anySatisfy: [:cat | cat = self selectedCategory]) - and: [(filters ifNil: [#()]) - allSatisfy: [:currFilter | (self perform: currFilter) - value: e]]]! Item was removed: - SMLoaderPlus subclass: #SMLoaderCategoricalPlus - instanceVariableNames: 'currentPackageList packagesListIndex' - classVariableNames: '' - poolDictionaries: '' - category: 'SMLoader'! - - !SMLoaderCategoricalPlus commentStamp: 'btr 12/4/2006 15:47' prior: 0! - A variant package loader that uses a more-or-less standard Smalltalk-80 browser perspective of selecting categories in one pane and then selecting items within in the next pane. - You can open one with: - - SMLoaderCategoricalPlus open! Item was removed: - ----- Method: SMLoaderCategoricalPlus class>>initialize (in category 'menu registration') ----- - initialize - Smalltalk at: #ToolBuilder ifPresent: [:tb | - (TheWorldMenu respondsTo: #registerOpenCommand:) - ifTrue: [TheWorldMenu registerOpenCommand: {self openMenuString. {self. #open}}]]! Item was removed: - ----- Method: SMLoaderCategoricalPlus class>>openMenuString (in category 'menu registration') ----- - openMenuString - ^ 'SqueakMap Categories'! Item was removed: - ----- Method: SMLoaderCategoricalPlus class>>removeFromSystem (in category 'menu registration') ----- - removeFromSystem - (TheWorldMenu respondsTo: #registerOpenCommand:) - ifTrue: [TheWorldMenu unregisterOpenCommand: self openMenuString]. - self removeFromSystem: true! Item was removed: - ----- Method: SMLoaderCategoricalPlus class>>unload (in category 'menu registration') ----- - unload - (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: - [TheWorldMenu unregisterOpenCommand: self openMenuString].! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>buildBrowsePanelWith: (in category 'interface') ----- - buildBrowsePanelWith: aBuilder - - | panel searchPaneHeight | - searchPaneHeight := aBuilder inputFieldHeight. - panel := aBuilder pluggablePanelSpec new. - panel children: OrderedCollection new. - panel children - add: ((self buildSearchPaneWith: aBuilder) - frame: (LayoutFrame - fractions: (0 @ 0 corner: 1 @ 0) - offsets: (0 @ 0 corner: 0@ searchPaneHeight))); - add: ((self buildPackagesListWith: aBuilder) - frame: (LayoutFrame - fractions: (0 @ 0 corner: 1 @ 1) - offsets: (0 @ searchPaneHeight corner: 0 at 0))). - ^ panel! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>buildWith: (in category 'interface') ----- - buildWith: aBuilder - | buttonBarHeight vertDivide horizDivide | - buttonBarHeight := aBuilder buttonRowHeight. - vertDivide := 0.5. - horizDivide := 0.6. - builder := aBuilder. - window := builder build: (builder pluggableWindowSpec new model: self; - label: #label; - children: (OrderedCollection new - add: ((self buildButtonBarWith: builder) - frame: (LayoutFrame - fractions: (0 @ 0 corner: 1 @ 0) - offsets: (0 at 0 corner: 0 at buttonBarHeight))); - add: ((self buildCategoriesListWith: builder) - frame: (LayoutFrame - fractions: (0 @ 0 corner: vertDivide @ horizDivide) - offsets: (0@ buttonBarHeight corner: 0 at 0))); - add: ((self buildBrowsePanelWith: builder) - frame: (LayoutFrame - fractions: (vertDivide @ 0 corner: 1 @ horizDivide) - offsets: (0 @ buttonBarHeight corner: 0 at 0))); - add: ((self buildPackagePaneWith: builder) - frame: (0 @ horizDivide corner: 1 @ 1)); - yourself); - yourself). - window on: #mouseEnter send: #paneTransition: to: window. - window on: #mouseLeave send: #paneTransition: to: window. - ^ window! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>currentPackageList (in category 'accessing') ----- - currentPackageList - ^currentPackageList! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>currentPackageList: (in category 'accessing') ----- - currentPackageList: aSymbol - currentPackageList := aSymbol. - self changed: #installButtonLabel.! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>defaultLabel (in category 'interface') ----- - defaultLabel - ^ 'Categorical ' , super defaultLabel! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>installButtonLabel (in category 'interface') ----- - installButtonLabel - ^ self currentPackageList = #notInstalled - ifTrue: ['Install the above package'] - ifFalse: ['Remove the above package']! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>installedPackageList (in category 'lists') ----- - installedPackageList - ^self packageList select: [:e | e isInstalled]! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>installedPackagesListIndex (in category 'accessing') ----- - installedPackagesListIndex - ^ self currentPackageList = #installed - ifTrue: [self packagesListIndex] - ifFalse: [0]! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>installedPackagesListIndex: (in category 'accessing') ----- - installedPackagesListIndex: anObject - packagesListIndex := anObject. - self currentPackageList ~= #installed - ifTrue: [self currentPackageList: #installed. - self changed: #currentPackageList]. - self noteChanged! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>isOn (in category 'accessing') ----- - isOn - ^false! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>notInstalledPackageList (in category 'lists') ----- - notInstalledPackageList - ^self packageList reject: [:e | e isInstalled]! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>notInstalledPackagesListIndex (in category 'accessing') ----- - notInstalledPackagesListIndex - ^ self currentPackageList = #notInstalled - ifTrue: [self packagesListIndex] - ifFalse: [0]! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>notInstalledPackagesListIndex: (in category 'accessing') ----- - notInstalledPackagesListIndex: anObject - packagesListIndex := anObject. - self currentPackageList ~= #notInstalled ifTrue: - [self currentPackageList: #notInstalled. - self changed: #currentPackageList]. - self changed: #packagesListIndex. - "update my selection" - self noteChanged. - self contentsChanged! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>noteChanged (in category 'private') ----- - noteChanged - self changed: #installedPackageList. - self changed: #notInstalledPackageList. - super noteChanged." - self changed: #packageNameList. - self changed: #packagesListIndex. - self changed: #categoriesForPackage. - self contentsChanged."! Item was removed: - ----- Method: SMLoaderCategoricalPlus>>packageList (in category 'lists') ----- - packageList - ^ self packages - select: [:e | (e categories - anySatisfy: [:cat | cat = self selectedCategory]) - and: [(filters ifNil: [#()]) - allSatisfy: [:currFilter | (self perform: currFilter) - value: e]]]! Item was removed: - Model subclass: #SMLoaderPlus - instanceVariableNames: 'packagesList selectedItem selectedCategory filters categoriesToFilterIds map builder window' - classVariableNames: 'DefaultCategoriesToFilterIds DefaultFilters' - poolDictionaries: '' - category: 'SMLoader'! - - !SMLoaderPlus commentStamp: 'btr 12/1/2006 15:16' prior: 0! - A simple package loader that is currently the standard UI for SqueakMap (the model is an SMSqueakMap instance). It uses ToolBuilder to construct its window. You can open one with: - - SMLoaderPlus open - - Instance Variables - categoriesToFilterIds: <OrderedCollection> The set of categories to filter the packages list. - filters: <OrderedCollection> The set of filters to apply to the packages list. - map: <SMSqueakMap> The model SqueakMap. - packagesList: <OrderedCollection> The list of packages from the map. - selectedCategory: <SMCategory> The current category. - selectedItem: <SMPackage> The selected package or release. - window: <PluggableSystemWindow> The window, held only so we can reOpen.! Item was removed: - ----- Method: SMLoaderPlus class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^self partName: 'Package Loader' - categories: #(Tools) - documentation: 'SqueakMap UI' - ! Item was removed: - ----- Method: SMLoaderPlus class>>initialize (in category 'class initialization') ----- - initialize - "Hook us up in the world menu." - "self initialize" - Smalltalk - at: #ToolBuilder - ifPresent: - [ : tb | self registerInFlapsRegistry. - (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 removed: - ----- Method: SMLoaderPlus class>>initializedInstance (in category 'new-morph participation') ----- - initializedInstance - ^ (ToolBuilder open: self new) extent: 400 at 400! Item was removed: - ----- Method: SMLoaderPlus class>>new (in category 'instance creation') ----- - new - "Create a SqueakMap loader on the default map." - - ^self newOn: SMSqueakMap default! Item was removed: - ----- Method: SMLoaderPlus class>>newOn: (in category 'instance creation') ----- - newOn: aMap - "Create a SqueakMap loader on given map." - - ^super new on: aMap; yourself! Item was removed: - ----- Method: SMLoaderPlus class>>newStandAlone (in category 'new-morph participation') ----- - newStandAlone - ^ ToolBuilder open: self new! Item was removed: - ----- Method: SMLoaderPlus class>>open (in category 'instance creation') ----- - open - "Create and open a SqueakMap Loader." - - "SMLoaderPlus open" - - ^ (Smalltalk at: #ToolBuilder) open: self new! Item was removed: - ----- Method: SMLoaderPlus class>>openMenuString (in category 'class initialization') ----- - openMenuString - ^ 'SqueakMap Catalog'! Item was removed: - ----- Method: SMLoaderPlus class>>openOn: (in category 'instance creation') ----- - openOn: aSqueakMap - "Create and open a SqueakMap Loader on a given map." - - "self openOn: SqueakMap default" - - ^ (Smalltalk at: #ToolBuilder) open: (self newOn: aSqueakMap)! Item was removed: - ----- Method: SMLoaderPlus class>>prototypicalToolWindow (in category 'new-morph participation') ----- - prototypicalToolWindow - "Do not update when creating a prototype window (used by flaps etc)" - - ^[(ToolBuilder open: self new) applyModelExtent; yourself] - valueSupplyingAnswers:{ {'*map on disk*'. false}}! Item was removed: - ----- Method: SMLoaderPlus class>>registerInFlapsRegistry (in category 'new-morph participation') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry." - - self environment - at: #Flaps - ifPresent: [:cl | (cl respondsTo: #registerQuad:forFlapNamed:) - ifTrue: [cl registerQuad: #(#SMLoader #prototypicalToolWindow 'Package Loader' 'The SqueakMap Package Loader' ) forFlapNamed: 'Tools']]! Item was removed: - ----- Method: SMLoaderPlus class>>setDefaultFilters: (in category 'class initialization') ----- - setDefaultFilters: anOrderedCollection - DefaultFilters := anOrderedCollection! Item was removed: - ----- Method: SMLoaderPlus class>>unload (in category 'class initialization') ----- - unload - (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: - [TheWorldMenu unregisterOpenCommand: self openMenuString]. - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: SMLoaderPlus>>addFiltersToMenu: (in category 'menus') ----- - addFiltersToMenu: aMenu - | filterSymbol help | - self filterSpecs do: [:filterArray | - filterSymbol := filterArray second. - help := filterArray third. - aMenu addUpdating: #showFilterString: target: self selector: #toggleFilterState: argumentList: (Array with: filterSymbol). - aMenu balloonTextForLastItem: help]. - aMenu addLine; - addList: #(('Clear all filters' uncheckFilters 'Unchecks all filters to list all packages')) - ! Item was removed: - ----- Method: SMLoaderPlus>>addSelectedCategoryAsFilter (in category 'actions') ----- - addSelectedCategoryAsFilter - "Add a new filter that filters on the currently selected category. - Make it enabled as default." - - categoriesToFilterIds add: self selectedCategory id! Item was removed: - ----- Method: SMLoaderPlus>>browseCacheDirectory (in category 'interface') ----- - browseCacheDirectory - "Open a FileList2 on the directory for the package or release." - | item dir win | - item := self selectedPackageOrRelease - ifNil: [^ nil]. - dir := item isPackage - ifTrue: [map cache directoryForPackage: item] - ifFalse: [map cache directoryForPackageRelease: item]. - win := FileList2 morphicViewOnDirectory: dir. - "withLabel: item name, ' cache directory'." - win openInWorld! Item was removed: - ----- Method: SMLoaderPlus>>buildBrowsePanelWith: (in category 'interface') ----- - buildBrowsePanelWith: aBuilder - - | panel vertDivide searchPaneHeight | - vertDivide := 0.6. - searchPaneHeight := aBuilder inputFieldHeight. - panel := aBuilder pluggablePanelSpec new. - panel wantsResizeHandles: true. - panel children: OrderedCollection new. - panel children - add: ((self buildSearchPaneWith: aBuilder) - frame: (LayoutFrame - fractions: (0 @ 0 corner: 1 @ 0) - offsets: (0 @ 0 corner: 0@ searchPaneHeight))); - add: ((self buildPackagesListWith: aBuilder) - frame: (LayoutFrame - fractions: (0 @ 0 corner: 1 @ vertDivide) - offsets: (0 @ searchPaneHeight corner: 0 at 0))); - add: ((self buildCategoriesListWith: aBuilder) - frame: (0 @ vertDivide corner: 1 @ 1)). - ^ panel! Item was removed: - ----- Method: SMLoaderPlus>>buildButtonBarWith: (in category 'interface') ----- - buildButtonBarWith: aBuilder - ^ aBuilder pluggablePanelSpec new - model: self; - layout: #horizontal; - children: (self commandSpecs select: [ :spec | spec fourth includes: #all] - thenCollect: [ :spec | - aBuilder pluggableActionButtonSpec new - model: self; - label: spec first; - action: spec second; - help: spec third; - enabled: ((spec fourth includes: #item) ifTrue: [#hasSelectedItem]); - yourself]); - name: #buttonBar; - yourself! Item was removed: - ----- Method: SMLoaderPlus>>buildButtonNamed:helpText:action: (in category 'interface') ----- - buildButtonNamed: labelText helpText: balloon action: action - | btn | - btn := PluggableButtonMorph on: self getState: nil action: action. - btn color: Color transparent; - hResizing: #shrinkWrap; - vResizing: #spaceFill; - label: labelText; - setBalloonText: balloon; - onColor: Color transparent offColor: Color transparent. - ^ btn! Item was removed: - ----- Method: SMLoaderPlus>>buildCategoriesListWith: (in category 'interface') ----- - buildCategoriesListWith: aBuilder - "Create the hierarchical list holding the category tree." - ^ aBuilder pluggableTreeSpec new model: self; - roots: #categoryList; - getSelectedPath: #selectedCategoryPath; - getChildren: #categoryChildren:; - hasChildren: #categoryHasChildren:; - setSelected: #selectedCategory:; - getSelected: #selectedCategory; - menu: #categoriesMenu:; - label: #categoryLabel:; - autoDeselect: true; - name: #categoriesList; - yourself! Item was removed: - ----- Method: SMLoaderPlus>>buildPackagePaneWith: (in category 'interface') ----- - buildPackagePaneWith: aBuilder - "Create the text area to the right in the loader." - - ^ aBuilder pluggableTextSpec new - model: self; - getText: #itemDescription; - name: #packagePane; - help: 'Select a package to view its description.'; - yourself! Item was removed: - ----- Method: SMLoaderPlus>>buildPackagesListWith: (in category 'interface') ----- - buildPackagesListWith: aBuilder - "Create the hierarchical list holding the packages and releases." - ^ aBuilder pluggableTreeSpec new model: self; - roots: #packageList; - getSelectedPath: #selectedItemPath; - getSelected: #selectedItem; - setSelected: #selectedItem:; - menu: #packagesMenu:; - label: #itemLabel:; - getChildren: #itemChildren:; - hasChildren: #itemHasChildren:; - autoDeselect: true; - name: #packagesList; - yourself! Item was removed: - ----- Method: SMLoaderPlus>>buildSearchPaneWith: (in category 'interface') ----- - buildSearchPaneWith: aBuilder - ^ aBuilder pluggableInputFieldSpec new model: self; - selection: #searchSelection; - setText: #findPackage:notifying:; - help: 'Search packages...'; - name: #search; - yourself! Item was removed: - ----- Method: SMLoaderPlus>>buildWith: (in category 'interface') ----- - buildWith: aBuilder - "Create the package loader window." - | buttonBarHeight searchPaneHeight horizDivide | - buttonBarHeight := aBuilder buttonRowHeight. - searchPaneHeight := aBuilder inputFieldHeight. - - horizDivide := 0.3. - builder := aBuilder. - window := builder build: (builder pluggableWindowSpec new model: self; - label: #label; - children: (OrderedCollection new - add: ((self buildButtonBarWith: builder) - frame: (LayoutFrame - fractions: (0 @ 0 corner: 1 @ 0) - offsets: (0 at 0 corner: 0 at buttonBarHeight))); - add: ((self buildBrowsePanelWith: builder) - frame: (LayoutFrame - fractions: (0 @ 0 corner: horizDivide @ 1) - offsets: (0 at buttonBarHeight corner: 0 at 0 ))); - add: ((self buildPackagePaneWith: builder) - frame: (LayoutFrame - fractions: (horizDivide @ 0 corner: 1 @ 1) - offsets: (0 @ buttonBarHeight corner: 0 at 0))); - yourself); - yourself). - window on: #mouseEnter send: #paneTransition: to: window. - window on: #mouseLeave send: #paneTransition: to: window. - ^ window! Item was removed: - ----- Method: SMLoaderPlus>>cachePackageReleaseAndOfferToCopy (in category 'actions') ----- - cachePackageReleaseAndOfferToCopy - "Cache package release, then offer to copy it somewhere. - Answer the chosen file's location after copy, - or the cache location if no directory was chosen." - - | release installer newDir newName newFile oldFile oldName | - release := self selectedPackageOrRelease. - release isPackageRelease ifFalse: [ self error: 'Should be a package release!!']. - installer := SMInstaller forPackageRelease: release. - [UIManager default informUser: 'Caching ' , release asString during: [installer cache]] on: Error do: [:ex | - | msg | - msg := ex messageText ifNil: [ex asString]. - self informException: ex msg: ('Error occurred during download:\', msg, '\') withCRs. - ^nil ]. - installer isCached ifFalse: [self inform: 'Download failed, see transcript for details'. ^nil]. - oldName := installer fullFileName. - newDir := UIManager default chooseDirectoryFrom: installer directory. - newDir ifNil: [ ^oldName ]. - newDir = installer directory ifTrue: [ ^oldName ]. - newName := newDir fullNameFor: installer fileName. - newFile := FileStream newFileNamed: newName. - newFile ifNil: [ ^oldName ]. - newFile binary. - oldFile := FileStream readOnlyFileNamed: oldName. - oldFile ifNil: [ ^nil ]. - oldFile binary. - [[ newDir copyFile: oldFile toFile: newFile ] ensure: [ oldFile close. newFile close ]] on: Error do: [ :ex | ^oldName ]. - ^newName! Item was removed: - ----- Method: SMLoaderPlus>>categoriesMenu: (in category 'menus') ----- - categoriesMenu: aMenu - "Answer the categories-list menu." - - self selectedCategory - ifNotNil: [aMenu addList: self categorySpecificOptions; addLine]. - aMenu addList: self generalOptions. - self addFiltersToMenu: aMenu. - ^aMenu! Item was removed: - ----- Method: SMLoaderPlus>>categoryChildren: (in category 'interface') ----- - categoryChildren: aCategory - ^ aCategory subCategories! Item was removed: - ----- Method: SMLoaderPlus>>categoryHasChildren: (in category 'interface') ----- - categoryHasChildren: aCategory - ^ aCategory hasSubCategories! Item was removed: - ----- Method: SMLoaderPlus>>categoryLabel: (in category 'interface') ----- - categoryLabel: aCategory - ^ aCategory name! Item was removed: - ----- Method: SMLoaderPlus>>categoryList (in category 'lists') ----- - categoryList - "Create the category list for the hierarchical list. - We sort the categories by name but ensure that 'Squeak versions' - is first if it exists." - | list first | - list := (map categories - select: [:each | each parent isNil]) asArray - sort: [:c1 :c2 | c1 name <= c2 name]. - first := list - detect: [:any | any name = 'Squeak versions'] - ifNone: []. - first - ifNotNil: [list := list copyWithout: first. - list := {first} , list]. - ^ list! Item was removed: - ----- Method: SMLoaderPlus>>categorySpecificOptions (in category 'menus') ----- - categorySpecificOptions - | choices | - choices := OrderedCollection new. - (categoriesToFilterIds includes: self selectedCategory id) - ifTrue: [ - choices add: #('Remove filter' #removeSelectedCategoryAsFilter 'Remove the filter for the selected category.')] - ifFalse: [ - choices add: #('Add as filter' #addSelectedCategoryAsFilter 'Add the selection as a filter to hide unrelated packages.')]. - categoriesToFilterIds isEmpty ifFalse: [ - choices add: #('Remove all filters' #removeCategoryFilters 'Remove all category filters.')]. - ^ choices! Item was removed: - ----- Method: SMLoaderPlus>>changeFilters: (in category 'accessing') ----- - changeFilters: anObject - "Update my selection." - - | oldItem index | - oldItem := self selectedPackageOrRelease. - filters := anObject. - self packagesListIndex: ((index := self packageList indexOf: oldItem) - ifNil: [0] - ifNotNil: [index]). - self noteChanged! Item was removed: - ----- Method: SMLoaderPlus>>commandSpecFor: (in category 'menus') ----- - commandSpecFor: selector - ^ self commandSpecs detect: [:spec | spec second = selector]! Item was removed: - ----- 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 removed: - ----- Method: SMLoaderPlus>>createNewRelease (in category 'actions') ----- - createNewRelease - SMReleaseBrowser - openOn: self selectedItem newUnattachedRelease initializeMandatoryCategories ; - yourself! Item was removed: - ----- Method: SMLoaderPlus>>defaultLabel (in category 'lists') ----- - defaultLabel - ^ 'SqueakMap Package Loader'! Item was removed: - ----- Method: SMLoaderPlus>>defaultWindowColor (in category 'user interface') ----- - defaultWindowColor - ^ (Color r: 0.801 g: 0.801 b: 0.614)! Item was removed: - ----- Method: SMLoaderPlus>>downloadPackageRelease (in category 'actions') ----- - downloadPackageRelease - "Force a download of the selected package release into the cache." - - | release | - release := self selectedPackageOrRelease. - release isPackageRelease ifFalse: [ self error: 'Should be a package release!!']. - [UIManager default informUser: 'Downloading ' , release asString during: [ - (SMInstaller forPackageRelease: release) download] - ] on: Error do: [:ex | - | msg | - msg := ex messageText ifNil: [ex asString]. - self informException: ex msg: ('Error occurred during download:\', msg, '\') withCRs]! Item was removed: - ----- Method: SMLoaderPlus>>emailPackageMaintainers (in category 'actions') ----- - emailPackageMaintainers - "Send mail to package owner and co-maintainers." - - | item package toAddresses | - item := self selectedPackageOrRelease ifNil: [^ nil]. - package := item isPackageRelease ifTrue: [item package] ifFalse: [item]. - - "(this logic should be moved to MailMessage as soon as it can handle - multiple To: addresses)" - toAddresses := '<', package owner email, '>'. - package maintainers ifNotNil: [ - package maintainers do: [:maintainer | - toAddresses := toAddresses, ', <', maintainer email, '>']]. - - SMUtilities sendMailTo: toAddresses regardingPackageRelease: item! Item was removed: - ----- Method: SMLoaderPlus>>filterAdd: (in category 'filter utilities') ----- - filterAdd: anObject - - self changeFilters: (self filters copyWith: anObject) - ! Item was removed: - ----- Method: SMLoaderPlus>>filterAutoInstall (in category 'filters') ----- - filterAutoInstall - ^[:package | package isInstallable]! Item was removed: - ----- Method: SMLoaderPlus>>filterAvailable (in category 'filters') ----- - filterAvailable - ^[:package | package isAvailable]! Item was removed: - ----- Method: SMLoaderPlus>>filterInstalled (in category 'filters') ----- - filterInstalled - ^[:package | package isInstalled]! Item was removed: - ----- Method: SMLoaderPlus>>filterNotInstalledYet (in category 'filters') ----- - filterNotInstalledYet - ^[:package | package isInstalled not]! Item was removed: - ----- Method: SMLoaderPlus>>filterNotUptoDate (in category 'filters') ----- - filterNotUptoDate - ^[:package | package isAvailable]! Item was removed: - ----- Method: SMLoaderPlus>>filterPublished (in category 'filters') ----- - filterPublished - ^[:package | package isPublished]! Item was removed: - ----- Method: SMLoaderPlus>>filterRemove: (in category 'filter utilities') ----- - filterRemove: anObject - - self changeFilters: (self filters copyWithout: anObject) - ! Item was removed: - ----- Method: SMLoaderPlus>>filterSafelyAvailable (in category 'filters') ----- - filterSafelyAvailable - ^[:package | package isSafelyAvailable]! Item was removed: - ----- Method: SMLoaderPlus>>filterSpecs (in category 'filter utilities') ----- - filterSpecs - "Return a specification for the filter menu. Is called each time." - | specs | - specs := #(#('Auto-installable packages' #filterAutoInstall 'display only packages that can be installed automatically') #('New available packages' #filterAvailable 'display only packages that are not installed or that have newer releases available.') #('New safely-available packages' #filterSafelyAvailable 'display only packages that are not installed or that have newer releases available that are safe to install, meaning that they are published and meant for the current version of Squeak.') #('Installed packages' #filterInstalled 'Display only packages that are installed.') #('Published packages' #filterPublished 'Display only packages that have at least one published release.') ) asOrderedCollection. - categoriesToFilterIds - do: [:catId | specs add: {'Packages in ' , (map object: catId) name. catId. 'Display only packages that are in the category.'}]. - ^ specs! Item was removed: - ----- Method: SMLoaderPlus>>filterVersion (in category 'filters') ----- - filterVersion - "Ignore spaces in the version string, they're sometimes spurious. - Not used anymore." - ^[:package | package categories anySatisfy: - [:cat | (cat name, '*') match: (Smalltalk version copyWithout: $ ) ]]! Item was removed: - ----- Method: SMLoaderPlus>>filters (in category 'filter utilities') ----- - filters - ^filters! Item was removed: - ----- Method: SMLoaderPlus>>findPackage:notifying: (in category 'actions') ----- - findPackage: aString notifying: aView - "Search and select a package with the given (sub) string in the name or - description. " - | index list match descriptions | - match := aString asString asLowercase. - index := self packagesListIndex. - list := self packageNameList. - list isEmpty - ifTrue: [^ self]. - descriptions := self packageList collect: [:e | e description]. - index + 1 - to: list size - do: [:i | (((list at: i) - includesSubstring: match - caseSensitive: false) - or: [(descriptions at: i) - includesSubstring: match - caseSensitive: false]) - ifTrue: [^ self packagesListIndex: i]]. - "wrap around" - 1 - to: index - do: [:i | (((list at: i) - includesSubstring: match - caseSensitive: false) - or: [(descriptions at: i) - includesSubstring: match - caseSensitive: false]) - ifTrue: [^ self packagesListIndex: i]]. - self inform: 'No package matching ' , aString asString! Item was removed: - ----- Method: SMLoaderPlus>>generalOptions (in category 'menus') ----- - generalOptions - ^#( #('Upgrade all installed packages' upgradeInstalledPackagesNoConfirm) - #('Upgrade all installed packages confirming each' upgradeInstalledPackagesConfirm) - #('Put list in paste buffer' listInPasteBuffer) - #('Save filters as default' saveFiltersAsDefault) - #- ) - - ! Item was removed: - ----- Method: SMLoaderPlus>>hasSelectedItem (in category 'private') ----- - hasSelectedItem - ^ self selectedPackageOrRelease notNil! Item was removed: - ----- Method: SMLoaderPlus>>help (in category 'interface') ----- - help - "Present help text. If there is a web server available, offer to open it. - Use the WebBrowser registry if possible, or Scamper if available." - | message browserClass | - message := 'Welcome to the SqueakMap package loader. - The names of packages are followed by versions: (installed -> latest). - If there is no arrow, your installed version of the package is the latest. - Bold packages and releases have been installed. - The checkbox menu items modify which packages you''ll see. - Take a look at them - only some packages are shown initially. - The options available for a package depend on how it was packaged. - Comment on a package by emailing the author or the squeak list.'. - - browserClass := Smalltalk at: #WebBrowser ifPresent: [ :registry | registry default ]. - browserClass := browserClass ifNil: [ Smalltalk at: #Scamper ifAbsent: [ ^self inform: message ]]. - - (self confirm: message, ' - Would you like to view more detailed help on the SqueakMap swiki page?') - ifTrue: [ browserClass openOnUrl: 'http://wiki.squeak.org/2726' asUrl]! Item was removed: - ----- Method: SMLoaderPlus>>informException:msg: (in category 'private') ----- - informException: ex msg: msg - "Tell the user that an error has occurred. - Offer to open debug notifier." - - (self confirm: msg, 'Would you like to open a debugger?') - ifTrue: [ex pass]! Item was removed: - ----- Method: SMLoaderPlus>>installPackageRelease (in category 'actions') ----- - installPackageRelease - "Install selected package or release. - The cache is used." - | item release | - item := self selectedPackageOrRelease - ifNil: [^ nil]. - item isPackageRelease - ifTrue: [^ self installPackageRelease: item] - ifFalse: [release := item lastReleaseForCurrentSystemVersion. - release - ifNil: [(self confirm: 'The package has no published release for your Squeak version, try releases for any Squeak version?') - ifTrue: [release := item lastPublishedRelease. - release - ifNil: [(self confirm: 'The package has no published release at all, take the latest of the unpublished releases?') - ifTrue: [release := item lastRelease]]]]. - release - ifNotNil: [^ self installPackageRelease: release]]! Item was removed: - ----- Method: SMLoaderPlus>>installPackageRelease: (in category 'private') ----- - installPackageRelease: aRelease - "Install a package release. The cache is used." - - | myRelease installer | - aRelease isCompatibleWithCurrentSystemVersion ifFalse: - [(self confirm: - 'The package you are about to install is not listed as - being compatible with your image version (', SystemVersion current majorMinorVersion, '), - so the package may not work properly. - Do you still want to proceed with the install?') - ifFalse: [^ self]]. - myRelease := self installedReleaseOfMe. - installer := SMInstaller forPackageRelease: aRelease. - [UIManager default informUser: 'Downloading ' , aRelease asString during: - [installer download]. - UIManager default informUser: 'Installing ' , aRelease asString during: [ - installer install. - myRelease = self installedReleaseOfMe - ifFalse: [self reOpen] - ifTrue: [self noteChanged]] - ] on: Error do: [:ex | - | msg | - msg := ex messageText ifNil:[ex asString]. - self informException: ex msg: ('Error occurred during install:\', msg, '\') withCRs].! Item was removed: - ----- Method: SMLoaderPlus>>installedReleaseOfMe (in category 'private') ----- - installedReleaseOfMe - "Return the release of the installed package loader." - - ^SMSqueakMap default installedReleaseOf: (SMSqueakMap default packageWithId: '941c0108-4039-4071-9863-a8d7d2b3d4a3').! Item was removed: - ----- Method: SMLoaderPlus>>itemChildren: (in category 'interface') ----- - itemChildren: anItem - ^ anItem isPackage - ifTrue: [ self sortReleases: anItem releases ] - ifFalse: [ #() ]! Item was removed: - ----- Method: SMLoaderPlus>>itemDescription (in category 'private') ----- - itemDescription - ^ self selectedPackageOrRelease - ifNotNil: [:item | item fullDescription]! Item was removed: - ----- Method: SMLoaderPlus>>itemHasChildren: (in category 'interface') ----- - itemHasChildren: anItem - ^ anItem isPackage and: [anItem releases notEmpty]! Item was removed: - ----- Method: SMLoaderPlus>>itemLabel: (in category 'interface') ----- - itemLabel: anItem - | label | - label := anItem isPackage - ifTrue: [anItem name - , (anItem versionLabel - ifEmpty: [''] - ifNotEmptyDo: [:lbl | ' (' , anItem versionLabel , ')'])] - ifFalse: [anItem smartVersion]. - ^ anItem isInstalled - ifTrue: [label asText allBold] - ifFalse: [label]! Item was removed: - ----- Method: SMLoaderPlus>>label (in category 'lists') ----- - label - ^ self - labelForShown: (packagesList - ifNil: [self packageList])! Item was removed: - ----- Method: SMLoaderPlus>>labelForFilter: (in category 'filter utilities') ----- - labelForFilter: aFilterSymbol - ^(self filterSpecs detect: [:fs | fs second = aFilterSymbol]) first! Item was removed: - ----- Method: SMLoaderPlus>>labelForShown: (in category 'lists') ----- - labelForShown: packagesShown - "Update the label of the window." - ^ self defaultLabel , ' (', - (packagesShown size < map packages size ifTrue: [packagesShown size printString, - ' shown out of '] ifFalse: ['']) , map packages size printString, ' packages)'! Item was removed: - ----- Method: SMLoaderPlus>>listInPasteBuffer (in category 'actions') ----- - listInPasteBuffer - "Useful when talking with people etc. - Uses the map to produce a nice String." - - Clipboard clipboardText: - (String streamContents: [:s | - packagesList do: [:p | - s nextPutAll: p nameWithVersionLabel; cr ]]) asText! Item was removed: - ----- Method: SMLoaderPlus>>loadUpdates (in category 'actions') ----- - loadUpdates - [UIManager default informUser: 'Loading Updates' during: [ - map loadUpdates. - self noteChanged ] - ] on: Error do: [:ex | - self informException: ex msg: ('Error occurred when updating map:\', ex messageText, '\') withCRs]! Item was removed: - ----- Method: SMLoaderPlus>>noteChanged (in category 'private') ----- - noteChanged - filters - ifNil: [^ self reOpen]. - map - ifNotNil: [packagesList := nil. - selectedCategory := nil. - self changed: #categoryList. - self changed: #packageList. - self changed: #packagesListIndex. - "update my selection" - self contentsChanged]! Item was removed: - ----- Method: SMLoaderPlus>>on: (in category 'initialization') ----- - on: aSqueakMap - "Initialize instance." - map := aSqueakMap. - map synchWithDisk. - filters := DefaultFilters copy. - categoriesToFilterIds := DefaultCategoriesToFilterIds copy! Item was removed: - ----- Method: SMLoaderPlus>>openReleaseEditor (in category 'actions') ----- - openReleaseEditor - SMReleaseBrowser openOn: self selectedItem ! Item was removed: - ----- Method: SMLoaderPlus>>package:filteredByCategory: (in category 'filter utilities') ----- - package: aPackage filteredByCategory: aCategory - "Answer true if the package should be shown - if we filter on <aCategory>. It should be shown - if itself or any of its releases has the category." - - | releases | - releases := aPackage releases. - ^(aPackage hasCategoryOrSubCategoryOf: aCategory) or: [ - releases anySatisfy: [:rel | - rel hasCategoryOrSubCategoryOf: aCategory]]! Item was removed: - ----- Method: SMLoaderPlus>>packageList (in category 'lists') ----- - packageList - "Return a list of the SMPackages that should be visible - by applying all the filters. Also filter based on the currently - selected category - if any." - | list | - list := packagesList ifNil: [packagesList := self packageListCalculated]. - selectedCategory ifNotNil: [ - list := list select: [:each | self package: each filteredByCategory: selectedCategory]]. - self updateLabel: list. - ^ list! Item was removed: - ----- Method: SMLoaderPlus>>packageListCalculated (in category 'lists') ----- - packageListCalculated - "Return a list of the SMPackages that should be visible - by applying all the filters. Also filter based on the currently - selected category - if any." - ^ self packages select: [:p | - filters allSatisfy: [:currFilter | - currFilter isSymbol - ifTrue: [(self perform: currFilter) value: p] - ifFalse: [self package: p filteredByCategory: (map object: currFilter)]]]! Item was removed: - ----- Method: SMLoaderPlus>>packageNameList (in category 'lists') ----- - packageNameList - ^ self packageList collect: [:e | e name]! Item was removed: - ----- 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) ]. - choices add: (self commandSpecFor: #emailPackageMaintainers). - packageOrRelease isPackageRelease ifTrue: [ choices add: (self commandSpecFor: #openReleaseEditor) ]. - choices add: (self commandSpecFor: #createNewRelease). - ^ choices! Item was removed: - ----- Method: SMLoaderPlus>>packages (in category 'private') ----- - packages - "We request the packages as sorted by name by default." - - ^map packagesByName asArray - ! Item was removed: - ----- Method: SMLoaderPlus>>packagesListIndex (in category 'accessing') ----- - packagesListIndex - ^ self packageList indexOf: self selectedItem! Item was removed: - ----- Method: SMLoaderPlus>>packagesListIndex: (in category 'accessing') ----- - packagesListIndex: anObject - self - selectedItem: (anObject = 0 - ifFalse: [self packageList at: anObject])! Item was removed: - ----- Method: SMLoaderPlus>>packagesMenu: (in category 'menus') ----- - packagesMenu: aMenu - "Answer the packages-list menu." - - self selectedPackageOrRelease - ifNotNil: [aMenu addList: self packageSpecificOptions; addLine]. - aMenu addList: self generalOptions. - self addFiltersToMenu: aMenu. - ^aMenu! Item was removed: - ----- Method: SMLoaderPlus>>reOpen (in category 'private') ----- - reOpen - "Close this package loader, probably because it has been updated, - and open a new one." - self inform: 'This package loader has been upgraded and will be closed and reopened to avoid strange side effects.'. - window delete. - (Smalltalk at: self class name) open! Item was removed: - ----- Method: SMLoaderPlus>>removeCategoryFilters (in category 'actions') ----- - removeCategoryFilters - "Remove all category filters." - - categoriesToFilterIds := OrderedCollection new! Item was removed: - ----- Method: SMLoaderPlus>>removeSelectedCategoryAsFilter (in category 'actions') ----- - removeSelectedCategoryAsFilter - "Remove the filter that filters on the currently selected category." - - categoriesToFilterIds remove: self selectedCategory id! Item was removed: - ----- Method: SMLoaderPlus>>representsSameBrowseeAs: (in category 'private') ----- - representsSameBrowseeAs: anotherSMLoaderPlus - ^ true! Item was removed: - ----- Method: SMLoaderPlus>>saveFiltersAsDefault (in category 'actions') ----- - saveFiltersAsDefault - "Save the current filters as default so that they - are selected the next time the loader is opened." - - DefaultFilters := filters copy. - DefaultCategoriesToFilterIds := categoriesToFilterIds copy! Item was removed: - ----- Method: SMLoaderPlus>>searchSelection (in category 'interface') ----- - searchSelection - "Selects all of the default search text so that a type-in overwrites it." - ^ {1. self searchText size}! Item was removed: - ----- Method: SMLoaderPlus>>searchText (in category 'interface') ----- - searchText - "A dummy default search text so that the field describes its purpose." - ^ ''! Item was removed: - ----- Method: SMLoaderPlus>>selectedCategory (in category 'accessing') ----- - selectedCategory - "Return selected category." - ^ selectedCategory! Item was removed: - ----- Method: SMLoaderPlus>>selectedCategory: (in category 'accessing') ----- - selectedCategory: anSMCategory - "Change the selected category." - selectedCategory := anSMCategory. - selectedCategory ifNotNil: - [ (selectedCategory objects includes: self selectedItem) ifFalse: [ self selectedItem: nil ] ]. - self - changed: #selectedCategory; - changed: #packageList! Item was removed: - ----- Method: SMLoaderPlus>>selectedCategoryPath (in category 'accessing') ----- - selectedCategoryPath - "Return selected category's path." - | path | - path := #(). - selectedCategory - ifNotNil: [selectedCategory parent - ifNotNil: [:p | path := path copyWith: p]. - path := path copyWith: selectedCategory]. - ^ path! Item was removed: - ----- Method: SMLoaderPlus>>selectedItem (in category 'accessing') ----- - selectedItem - ^ selectedItem! Item was removed: - ----- Method: SMLoaderPlus>>selectedItem: (in category 'accessing') ----- - selectedItem: anItem - "This == workaround protects us from recursion since ToolBuilder's tree widgets will always tell us that the selection has been updated when we tell it that the selection path has been updated. Cleaner solutions invited." - anItem == selectedItem ifFalse: [ - selectedItem := anItem. - self changed: #selectedItem. - self changed: #itemDescription. - self changed: #hasSelectedItem]! Item was removed: - ----- Method: SMLoaderPlus>>selectedItemPath (in category 'accessing') ----- - selectedItemPath - | path | - path := #(). - (selectedItem isKindOf: SMPackageRelease) - ifTrue: [path := path copyWith: selectedItem package]. - selectedItem - ifNotNil: [path := path copyWith: selectedItem]. - ^ path! Item was removed: - ----- Method: SMLoaderPlus>>selectedPackageOrRelease (in category 'accessing') ----- - selectedPackageOrRelease - "Return selected package or package release." - ^ selectedItem! Item was removed: - ----- Method: SMLoaderPlus>>showFilterString: (in category 'filter utilities') ----- - showFilterString: aFilterSymbol - ^(self stateForFilter: aFilterSymbol), (self labelForFilter: aFilterSymbol)! Item was removed: - ----- Method: SMLoaderPlus>>sortReleases: (in category 'private') ----- - sortReleases: anOrderedCollection - "SqueakMap stores them in chronological order, let's list them in reverse-chronological order for easy-selection." - | answer headIndex | - answer := anOrderedCollection reversed. - "After that, look for the 'head' release, put it to the top." - headIndex := answer findFirst: - [ : each | each version = 'head' ]. - headIndex > 1 ifTrue: [ answer addFirst: (answer removeAt: headIndex) ]. - ^ answer! Item was removed: - ----- Method: SMLoaderPlus>>stateForFilter: (in category 'filter utilities') ----- - stateForFilter: aFilterSymbol - ^(self filters includes: aFilterSymbol) ifTrue: ['<yes>'] ifFalse: ['<no>'] - - ! Item was removed: - ----- Method: SMLoaderPlus>>toggleFilterState: (in category 'filter utilities') ----- - toggleFilterState: aFilterSymbol - - ^(self filters includes: (aFilterSymbol)) - ifTrue: [self filterRemove: aFilterSymbol] - ifFalse: [self filterAdd: aFilterSymbol]! Item was removed: - ----- Method: SMLoaderPlus>>uncheckFilters (in category 'actions') ----- - uncheckFilters - "Uncheck all filters." - - filters := OrderedCollection new. - self noteChanged! Item was removed: - ----- Method: SMLoaderPlus>>updateLabel: (in category 'lists') ----- - updateLabel: packagesShown - "Update the label of the window." - window ifNotNil: [:w | w setLabel: (self labelForShown: packagesShown)]! Item was removed: - ----- Method: SMLoaderPlus>>upgradeInstalledPackages (in category 'actions') ----- - upgradeInstalledPackages - "Tries to upgrade all installed packages to the latest published release for this - version of Squeak. So this is a conservative approach." - - | installed old myRelease toUpgrade info | - installed := map installedPackages. - old := map oldPackages. - old isEmpty ifTrue: [ - ^self inform: 'All ', installed size printString, ' installed packages are up to date.']. - toUpgrade := map upgradeableAndOldPackages. - toUpgrade isEmpty ifTrue: [ - ^self inform: 'None of the ', old size printString, ' old packages of the ', installed size printString, ' installed can be automatically upgraded. You need to upgrade them manually.']. - info := old size < toUpgrade size ifTrue: [ - 'Of the ', old size printString, ' old packages only ', toUpgrade size printString, ' can be upgraded. - The following packages will not be upgraded: - ', (String streamContents: [:s | (old removeAll: toUpgrade; yourself) - do: [:p | s nextPutAll: p nameWithVersionLabel; cr]])] - ifFalse: ['All old packages upgradeable.']. - (self confirm: info, ' - About to upgrade the following packages: - ', (String streamContents: [:s | toUpgrade do: [:p | s nextPutAll: p nameWithVersionLabel; cr]]), 'Proceed?') ifTrue: [ - myRelease := self installedReleaseOfMe. - [UIManager default informUser: 'Upgrading Installed Packages' during: [ - map upgradeOldPackages. - self inform: toUpgrade size printString, ' packages successfully upgraded.'. - myRelease = self installedReleaseOfMe - ifFalse: [self reOpen] - ifTrue: [self noteChanged]] - ] on: Error do: [:ex | - self informException: ex msg: ('Error occurred when upgrading old packages:\', ex messageText, '\') withCRs]]! Item was removed: - ----- Method: SMLoaderPlus>>upgradeInstalledPackagesConfirm (in category 'actions') ----- - upgradeInstalledPackagesConfirm - "Tries to upgrade all installed packages to the latest published release for this - version of Squeak. Confirms on each upgrade." - - ^ self upgradeInstalledPackagesConfirm: true! Item was removed: - ----- Method: SMLoaderPlus>>upgradeInstalledPackagesConfirm: (in category 'private') ----- - upgradeInstalledPackagesConfirm: confirmEach - "Tries to upgrade all installed packages to the latest published release for - this version of Squeak. If confirmEach is true we ask for every - upgrade. " - | installed old myRelease toUpgrade info | - installed := map installedPackages. - old := map oldPackages. - old isEmpty - ifTrue: [^ self inform: 'All ' , installed size printString , ' installed packages are up to date.']. - toUpgrade := map upgradeableAndOldPackages. - toUpgrade isEmpty - ifTrue: [^ self inform: 'None of the ' , old size printString , ' old packages of the ' , installed size printString , ' installed can be automatically upgraded. You need to upgrade them manually.']. - info := old size < toUpgrade size - ifTrue: ['Of the ' , old size printString , ' old packages only ' , toUpgrade size printString , ' can be upgraded. - The following packages will not be upgraded: - ' - , (String - streamContents: [:s | (old removeAll: toUpgrade; - yourself) - do: [:p | s nextPutAll: p nameWithVersionLabel; - cr]])] - ifFalse: ['All old packages upgradeable.']. - (self confirm: info , ' - About to upgrade the following packages: - ' - , (String - streamContents: [:s | toUpgrade - do: [:p | s nextPutAll: p nameWithVersionLabel; - cr]]) , 'Proceed?') - ifTrue: [myRelease := self installedReleaseOfMe. - [UIManager default informUser: 'Upgrading Installed Packages' during: - [confirmEach - ifTrue: [map - upgradeOldPackagesConfirmBlock: [:p | self confirm: 'Upgrade ' , p installedRelease packageNameWithVersion , ' to ' , (p lastPublishedReleaseForCurrentSystemVersionNewerThan: p installedRelease) listName , '?']] - ifFalse: [map upgradeOldPackages]. - self inform: toUpgrade size printString , ' packages successfully processed.'. - myRelease = self installedReleaseOfMe - ifTrue: [self noteChanged] - ifFalse: [self reOpen]]] - on: Error - do: [:ex | self informException: ex msg: ('Error occurred when upgrading old packages:\' , ex messageText , '\') withCRs]]! Item was removed: - ----- Method: SMLoaderPlus>>upgradeInstalledPackagesNoConfirm (in category 'actions') ----- - upgradeInstalledPackagesNoConfirm - "Tries to upgrade all installed packages to the latest published release for this - version of Squeak. No confirmation on each upgrade." - - ^ self upgradeInstalledPackagesConfirm: false! Item was removed: - ----- 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) downloadUrl: String empty! Item was removed: - ----- 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 removed: - ----- Method: SMPackageRelease>>compatibility (in category '*smloader') ----- - compatibility - ^ self categories - detect: - [ : each | each parent = self map compatibilityLevels ] - ifNone: [ ]! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: SMPackageRelease>>fullyQualifiedScriptName (in category '*smloader') ----- - fullyQualifiedScriptName - ^ self package owner downloadsDirectory , '/', self scriptName ! Item was removed: - ----- Method: SMPackageRelease>>httpPostContent (in category '*smloader') ----- - httpPostContent - "Answer the url-encoded parameters for this object." - | allCategories | - ^ String streamContents: - [ : stream | self isNewObject - ifTrue: - [ "Make the parent release the selected." - self parentReleaseIndex > 0 ifTrue: [ stream nextPutAll: '1-1=' , self parentReleaseIndex , '&' ] ] - ifFalse: - [ "Make this release the selected." - self releaseIndex > 0 ifTrue: [ stream nextPutAll: '1-1=' , self releaseIndex , '&' ] ]. - "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." - stream - nextPutAll: '1-3=' , self version asString encodeForHTTP ; - 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 sortedCategories. - {allCategories indexOf: self compatibility. - allCategories indexOf: self license. - allCategories indexOf: self maturity. - allCategories indexOf: self squeakVersion} do: - [ : each | stream nextPutAll: '&1-12=' , each asString ]. - self isCommunitySupported ifTrue: [ stream nextPutAll: '&1-12=', (allCategories indexOf: self communitySupportedCategory) asString ]. - stream nextPutAll: '&1-13=' , self note asString encodeForHTTP. - self isNewObject - ifTrue: [ stream nextPutAll: '&1-18=Save+as+new+release' ] - ifFalse: [ stream nextPutAll: '&1-17=Save+changes' ]. - self parentRelease ifNotNil: - [ : pr | stream nextPutAll: '&1-19=' , pr releaseIndex ] ]! Item was removed: - ----- 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 removed: - ----- Method: SMPackageRelease>>isNewObject (in category '*smloader') ----- - isNewObject - ^ (self package releases includes: self) not! Item was removed: - ----- Method: SMPackageRelease>>license (in category '*smloader') ----- - license - ^ self categories - detect: - [ : each | each parent = self map licenses ] - ifNone: [ ]! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: SMPackageRelease>>maturity (in category '*smloader') ----- - maturity - ^ self categories - detect: - [ : each | each parent = self map maturityLevels ] - ifNone: [ nil ]! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: SMPackageRelease>>newUnattachedRelease (in category '*smloader') ----- - newUnattachedRelease - "Create and answer a new release based on this release." - ^ self package newUnattachedReleaseFrom: self! Item was removed: - ----- Method: SMPackageRelease>>parentReleaseIndex (in category '*smloader') ----- - parentReleaseIndex - "Answer my position in the list of my packages releases." - ^ self parentRelease - ifNil: [ 0 ] - ifNotNil: [ : pr | pr releaseIndex ]! Item was removed: - ----- Method: SMPackageRelease>>releaseIndex (in category '*smloader') ----- - releaseIndex - "Answer my position in the list of my packages releases." - ^ self package releases indexOf: self! Item was removed: - ----- Method: SMPackageRelease>>scriptName (in category '*smloader') ----- - scriptName - ^ 'install-', self package name, '-', self version, '.st'! Item was removed: - ----- Method: SMPackageRelease>>squeakVersion (in category '*smloader') ----- - squeakVersion - ^ self categories - detect: - [ : each | each parent = self map squeakVersions ] - ifNone: [ ]! Item was removed: - ----- 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 removed: - ----- 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 removed: - ListItemWrapper subclass: #SMPackageReleaseWrapper - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'SMLoader'! - - !SMPackageReleaseWrapper commentStamp: 'gk 6/21/2005 10:54' prior: 0! - This is a wrapper for showing the SqueakMap package releases (SMPackageRelease) using the SimpleHierarchicalListMorph in the SMLoader, see SMPackageWrapper>>contents.! Item was removed: - ----- Method: SMPackageReleaseWrapper>>asString (in category 'converting') ----- - asString - "Show installed releases with a trailing asterisk." - | string | - string := item smartVersion. - "Older SMBase versions don't have isInstalled.'" - (item respondsTo: #isInstalled) ifTrue: - [item isInstalled ifTrue: [string := (string , ' *') asText allBold]]. - ^ string! Item was removed: - ----- Method: SMPackageReleaseWrapper>>contents (in category 'accessing') ----- - contents - ^ #()! Item was removed: - ----- Method: SMPackageReleaseWrapper>>label (in category 'accessing') ----- - label - ^ self asString - ! Item was removed: - ListItemWrapper subclass: #SMPackageWrapper - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'SMLoader'! - - !SMPackageWrapper commentStamp: '<historical>' prior: 0! - This is a wrapper for showing the SqueakMap packages (SMPackage) using the SimpleHierarchicalListMorph in the SMLoader, see SMLoader>>packageWrapperList.! Item was removed: - ----- Method: SMPackageWrapper>>= (in category 'comparing') ----- - = anObject - ^self withoutListWrapper = anObject withoutListWrapper! Item was removed: - ----- Method: SMPackageWrapper>>asString (in category 'converting') ----- - asString - | string | - string := item name, ' (', item versionLabel, ')'. - item isInstalled ifTrue: [string := string asText allBold]. - "(string includesSubString: '->') ifTrue: [string := string asText color: Color green]." - ^ string! Item was removed: - ----- Method: SMPackageWrapper>>contents (in category 'accessing') ----- - contents - ^item releases reversed collect: [:e | SMPackageReleaseWrapper with: e]! Item was removed: - ----- Method: SMPackageWrapper>>hash (in category 'testing') ----- - hash - ^self withoutListWrapper hash! Item was removed: - ----- Method: SMPackageWrapper>>help (in category 'accessing') ----- - help - ^ 'This shows all packages with their releases that should be displayed according the current filter.'! Item was removed: - ----- Method: SMPackageWrapper>>label (in category 'accessing') ----- - label - ^ self asString! Item was removed: - ----- Method: SMPackageWrapper>>printOn: (in category 'printing') ----- - printOn: aStream - aStream nextPutAll: 'wrapper for: ', item printString! Item was removed: - CodeHolder subclass: #SMReleaseBrowser - instanceVariableNames: 'release loadScript smClient' - classVariableNames: '' - poolDictionaries: '' - category: 'SMLoader'! - - !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 removed: - ----- Method: SMReleaseBrowser class>>open (in category 'open') ----- - open - ^ ToolBuilder open: self! Item was removed: - ----- Method: SMReleaseBrowser class>>openOn: (in category 'open') ----- - openOn: aSMPackageRelease - ^ ToolBuilder open: (self release: aSMPackageRelease)! Item was removed: - ----- Method: SMReleaseBrowser class>>release: (in category 'instance creation') ----- - release: aSMPackageRelease - ^ self new - setRelease: aSMPackageRelease ; - yourself! Item was removed: - ----- Method: SMReleaseBrowser class>>yellowButtonMenuItems (in category 'menu') ----- - yellowButtonMenuItems - "Returns the standard yellow button menu items" - ^super yellowButtonMenuItems, { - {'update with loaded versions' translated. #updateLoadScript}. - }! Item was removed: - ----- Method: SMReleaseBrowser>>aboutToStyle: (in category 'as yet unclassified') ----- - aboutToStyle: aStyler - ^ true.! Item was removed: - ----- Method: SMReleaseBrowser>>annotation (in category 'toolbuilder') ----- - annotation - ^ String streamContents: - [ : stream | stream - nextPutAll: 'last saved ' ; - print: release updated ]! Item was removed: - ----- Method: SMReleaseBrowser>>buildCodePaneWith: (in category 'toolbuilder') ----- - buildCodePaneWith: aToolBuilder - ^ (super buildCodePaneWith: aToolBuilder) - name: #content ; - yourself! Item was removed: - ----- 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). - (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) }. - ^ aToolBuilder build: windowSpec! Item was removed: - ----- Method: SMReleaseBrowser>>closeWindow (in category 'private') ----- - closeWindow - self dependents do: - [ : each | each isSystemWindow ifTrue: [ each delete ] ]! Item was removed: - ----- Method: SMReleaseBrowser>>compatibilities (in category 'model access') ----- - compatibilities - ^ SMSqueakMap default compatibilityLevels subCategories! Item was removed: - ----- Method: SMReleaseBrowser>>compatibility (in category 'model access') ----- - compatibility - ^ release compatibility! Item was removed: - ----- Method: SMReleaseBrowser>>compatibility: (in category 'model access') ----- - compatibility: aSMCategory - release compatibility: aSMCategory. - self changed: #compatibility! Item was removed: - ----- Method: SMReleaseBrowser>>contents (in category 'toolbuilder') ----- - contents - ^ self loadScript! Item was removed: - ----- Method: SMReleaseBrowser>>contents: (in category 'model access') ----- - contents: aText - self loadScript: aText. - self changed: #contents! Item was removed: - ----- Method: SMReleaseBrowser>>contents:notifying: (in category 'model access') ----- - contents: aText notifying: aController - self contents: aText. - ^ true! Item was removed: - ----- Method: SMReleaseBrowser>>defaultWindowColor (in category 'user interface') ----- - defaultWindowColor - ^ (Color r: 0.801 g: 0.801 b: 0.614)! Item was removed: - ----- Method: SMReleaseBrowser>>deleteInstallFile (in category 'private') ----- - deleteInstallFile - FileDirectory default deleteFileNamed: release scriptName! Item was removed: - ----- Method: SMReleaseBrowser>>downloadUrl (in category 'private') ----- - downloadUrl - ^ self smAccount downloadsDirectory , '/' , release scriptName! Item was removed: - ----- Method: SMReleaseBrowser>>exampleLoadScript (in category 'private') ----- - exampleLoadScript - "this is an example load script to offer the user rather than a blank view" - - ^'"This is where you need to provide an install script; you may need to handle prerequisites first and then load the actual package(s) Take a look at http://wiki.squeak.org/squeak/6182 for more info, especially about creating a ''load latest version'' script" - "Example to load a prerequisite package - " - SMSqueakMap default - installPackageNamed: ''myPackage'' - version: ''release name''. - "Example to load myPackage if a certain class is not already in the image -" - (Smalltalk hasClassNamed: #MyPackage) - ifFalse:[SMSqueakMap default - installPackageNamed: ''myPackage'' - version: ''release name'']. - "Or load several specifc mcz files -" - #( ''MyPackagePartA-abc.1.mcz'' ''MyPackagePartB-abc.42.mcz'' ) do: - [:each| (Installer repository: ''http://www.squeaksource.com/MyPackages'') install: each]'! Item was removed: - ----- Method: SMReleaseBrowser>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - smClient := SMClient new! Item was removed: - ----- Method: SMReleaseBrowser>>labelString (in category 'toolbuilder') ----- - labelString - ^ String streamContents: - [ : stream | stream nextPutAll: release package name. - release version isEmptyOrNil ifFalse: - [ stream - space ; - nextPutAll: release version ] ]! Item was removed: - ----- Method: SMReleaseBrowser>>license (in category 'model access') ----- - license - ^ release license! Item was removed: - ----- Method: SMReleaseBrowser>>license: (in category 'model access') ----- - license: aSMCategory - release license: aSMCategory. - self changed: #license! Item was removed: - ----- Method: SMReleaseBrowser>>licenses (in category 'model access') ----- - licenses - "Answer the 'Licenses' subCagegories." - ^ SMSqueakMap default licenses subCategories! Item was removed: - ----- 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]] - ifTrue: [self exampleLoadScript]]! Item was removed: - ----- 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 ; - changed: #contents! Item was removed: - ----- Method: SMReleaseBrowser>>login (in category 'private') ----- - login - smClient login! Item was removed: - ----- Method: SMReleaseBrowser>>logout (in category 'private') ----- - logout - smClient close. - self - changed: #username ; - changed: #password! Item was removed: - ----- Method: SMReleaseBrowser>>maturities (in category 'model access') ----- - maturities - ^ SMSqueakMap default maturityLevels subCategories! Item was removed: - ----- Method: SMReleaseBrowser>>maturity (in category 'model access') ----- - maturity - ^ release maturity! Item was removed: - ----- Method: SMReleaseBrowser>>maturity: (in category 'model access') ----- - maturity: aSMCategory - release maturity: aSMCategory. - self changed: #maturity! Item was removed: - ----- 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 and close the window.' ; - label: 'Save' ; - action: #save ; - frame: (0.77 at 0 corner: 0.98 at 1) ; - yourself)) ; - yourself! Item was removed: - ----- Method: SMReleaseBrowser>>newCompatibilitySpec: (in category 'toolbuilder') ----- - newCompatibilitySpec: aToolBuilder - ^ aToolBuilder pluggableListSpec new - model: self ; - name: #compatibilities ; - help: 'Select the type of changes this release makes to the image.' ; - autoDeselect: false ; - list: #compatibilities ; - getSelected: #compatibility ; - setSelected: #compatibility: ; - yourself! Item was removed: - ----- Method: SMReleaseBrowser>>newLicenseListSpec: (in category 'toolbuilder') ----- - newLicenseListSpec: aToolBuilder - ^ aToolBuilder pluggableListSpec new - model: self ; - name: #licenses ; - help: 'Select the license for this release.' ; - autoDeselect: false ; - list: #licenses ; - getSelected: #license ; - setSelected: #license: ; - yourself! Item was removed: - ----- Method: SMReleaseBrowser>>newMaturitySpec: (in category 'toolbuilder') ----- - newMaturitySpec: aToolBuilder - ^ aToolBuilder pluggableListSpec new - model: self ; - name: #maturities ; - help: 'Select the type of changes this release makes to the image.' ; - autoDeselect: false ; - list: #maturities ; - getSelected: #maturity ; - setSelected: #maturity: ; - yourself! Item was removed: - ----- 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 removed: - ----- Method: SMReleaseBrowser>>newSqueakVersionSpec: (in category 'toolbuilder') ----- - newSqueakVersionSpec: aToolBuilder - ^ aToolBuilder pluggableListSpec new - model: self ; - name: #licenses ; - help: 'Select the image version for this release.' ; - autoDeselect: false ; - list: #squeakVersions ; - getSelected: #squeakVersion ; - setSelected: #squeakVersion: ; - yourself! Item was removed: - ----- Method: SMReleaseBrowser>>newVersionSpec: (in category 'toolbuilder') ----- - newVersionSpec: aToolBuilder - ^ aToolBuilder pluggableInputFieldSpec new - model: self ; - name: #version ; - help: 'Specify the version name of this release.' ; - getText: #version ; - setText: #version:! Item was removed: - ----- Method: SMReleaseBrowser>>note (in category 'model access') ----- - note - ^ release note! Item was removed: - ----- Method: SMReleaseBrowser>>note: (in category 'model access') ----- - note: aString - release note: aString. - self changed: #note! Item was removed: - ----- Method: SMReleaseBrowser>>okToChange (in category 'toolbuilder') ----- - okToChange - "Answer true so that merely selecting different categories doesn't cause a pop-up." - ^ true! Item was removed: - ----- Method: SMReleaseBrowser>>parentRelease (in category 'model access') ----- - parentRelease - ^ release ifNotNil: [ release parentRelease ]! Item was removed: - ----- Method: SMReleaseBrowser>>parentVersion (in category 'model access') ----- - parentVersion - ^ self parentRelease ifNotNil: - [ : pr | pr version ]! Item was removed: - ----- Method: SMReleaseBrowser>>password (in category 'model access') ----- - password - "The SqueakMap password." - ^ smClient password! Item was removed: - ----- Method: SMReleaseBrowser>>password: (in category 'model access') ----- - password: aString - "The SqueakMap username." - smClient password: aString asString. - self changed: #password! Item was removed: - ----- Method: SMReleaseBrowser>>postInitialize (in category 'initialize-release') ----- - postInitialize - (release downloadUrl endsWith: '.st') ifTrue: - [ release ensureInCache ifTrue: [ self loadScript: release contents ] ]! Item was removed: - ----- Method: SMReleaseBrowser>>release (in category 'private') ----- - release - ^ release! Item was removed: - ----- Method: SMReleaseBrowser>>representsSameBrowseeAs: (in category 'private') ----- - representsSameBrowseeAs: anotherModel - ^ release = anotherModel release! Item was removed: - ----- 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 validateCanSave. - [ self - writeInstallFile ; - login. - "Save without a downloadUrl so that SM will update its cache and we can also verify success before uploading the file." - self savePackageRelease: nil. - self loadScript isEmptyOrNil ifFalse: - [ self uploadInstallFile. - release package addRelease: release. - "Now save with the correct downloadUrl." - self - savePackageRelease: self downloadUrl ; - deleteInstallFile ] ] ensure: [ self logout ]. - release refreshInCache ]. - self closeWindow! Item was removed: - ----- Method: SMReleaseBrowser>>savePackageRelease: (in category 'private') ----- - savePackageRelease: downloadUrlString - "We actually save the package-release to the users who is posting it, even if that is different than the owner." - "Set sha1sum so it will be 'correct' until the next update from the SM server." - | response | - release - downloadUrl: downloadUrlString ; - sha1sum: nil. - response := smClient save: release. - (response isSuccess not or: - [ #('error' 'failed' ) anySatisfy: - [ : each | response content - includesSubstring: each - caseSensitive: false ] ]) ifTrue: [ self error: 'failed' ]. - release - removeFromLocalCache ; - addToLocalCache! Item was removed: - ----- Method: SMReleaseBrowser>>setRelease: (in category 'initialize-release') ----- - setRelease: aSMPackageRelease - release := aSMPackageRelease. - self postInitialize! Item was removed: - ----- Method: SMReleaseBrowser>>smAccount (in category 'private') ----- - smAccount - ^ SMSqueakMap default accountForUsername: self username! Item was removed: - ----- Method: SMReleaseBrowser>>squeakVersion (in category 'model access') ----- - squeakVersion - ^ release squeakVersion! Item was removed: - ----- Method: SMReleaseBrowser>>squeakVersion: (in category 'model access') ----- - squeakVersion: aSMCategory - release squeakVersion: aSMCategory. - self changed: #squeakVersion! Item was removed: - ----- Method: SMReleaseBrowser>>squeakVersions (in category 'model access') ----- - squeakVersions - "Answer the squeak-versions subcategories." - ^ SMSqueakMap default squeakVersions subCategories! Item was removed: - ----- Method: SMReleaseBrowser>>updateLoadScript (in category 'model access') ----- - updateLoadScript - self loadScript: self loadScript withLoadedPackageVersions! Item was removed: - ----- 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 removed: - ----- Method: SMReleaseBrowser>>userError: (in category 'private') ----- - userError: aString - UIManager default inform: aString! Item was removed: - ----- Method: SMReleaseBrowser>>username (in category 'model access') ----- - username - "The SqueakMap username." - ^ smClient username! Item was removed: - ----- Method: SMReleaseBrowser>>username: (in category 'model access') ----- - username: aString - "The SqueakMap username." - smClient username: aString asString. - self changed: #username! Item was removed: - ----- Method: SMReleaseBrowser>>validateCanSave (in category 'private') ----- - validateCanSave - "accept any changes in the text field morphs etc, then validate the input as best we can" - self changed: #acceptChanges. - self username isEmptyOrNil ifTrue: [ self userError: 'username required' ]. - self note isEmptyOrNil ifTrue: [ self userError: 'note required' ]. - self version isEmptyOrNil - ifTrue: [ self userError: 'version required' ] - ifFalse: - [ (self version includes: $+) ifTrue: [ self userError: 'Plus sign not allowed in version name because it is reserved by HTTP.' ] ]! Item was removed: - ----- Method: SMReleaseBrowser>>version (in category 'model access') ----- - version - ^ release ifNotNil: [ release version ]! Item was removed: - ----- Method: SMReleaseBrowser>>version: (in category 'model access') ----- - version: aString - release ifNotNil: [ release version: aString asString ]. - self - changed: #version ; - changed: #labelString! Item was removed: - ----- Method: SMReleaseBrowser>>writeInstallFile (in category 'private') ----- - writeInstallFile - (FileDirectory default fileExists: release scriptName) - ifTrue: [Warning signal: release scriptName , ' already exists and will be deleted.']. - self deleteInstallFile. - FileStream - fileNamed: release scriptName - do: [:stream | stream nextPutAll: self loadScript asString]! Item was removed: - ----- Method: SMSqueakMap>>alpha (in category '*smloader') ----- - alpha - "Answer the default license selection for new packages, MIT." - ^ self categoryWithNameBeginning: 'Alpha'! Item was removed: - ----- Method: SMSqueakMap>>compatibilityLevels (in category '*smloader') ----- - compatibilityLevels - ^ self categoryWithNameBeginning: 'Compatibility level'! Item was removed: - ----- 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 removed: - ----- Method: SMSqueakMap>>licenses (in category '*smloader') ----- - licenses - ^ self categoryWithNameBeginning: 'Licenses'! Item was removed: - ----- Method: SMSqueakMap>>maturityLevels (in category '*smloader') ----- - maturityLevels - ^ self categoryWithNameBeginning: 'Maturity level'! Item was removed: - ----- Method: SMSqueakMap>>mit (in category '*smloader') ----- - mit - "Answer the default license selection for new packages, MIT." - ^ self categoryWithNameBeginning: 'MIT' ! Item was removed: - ----- Method: SMSqueakMap>>onlyExtensions (in category '*smloader') ----- - onlyExtensions - "Answer the default license selection for new packages, MIT." - ^ self categoryWithNameBeginning: 'Only extensions, no changes'! Item was removed: - ----- 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 |