'From Squeak3.3alpha of 12 January 2002 [latest update: #4761] on 17 February 2002 at 5:45:34 am'! "Change Set: fileListTweaks-sw Date: 17 February 2002 Author: Scott Wallace From 3.3a update 4766fileListTweaks-sw.cs. Tweaks following the incorporation of file-list-registry updates from Stephane and Masato. The file-list button pane (in morphic) now dynamically offers buttons that are appropriate to the suffix of the selected file. Items in the code pane menu of the FileList that apply to the file as a whole (rather than the current selectioin) -- view hex, get entire file, etc., are restored (they'd gotten temporarily lost) and now only those items that specificially apply are offered. Abbreviated item wordings when used in buttons. Some wordings and help messages tuned. etc."! Object subclass: #SimpleServiceEntry instanceVariableNames: 'provider label selector useLineAfter stateSelector description argumentGetter buttonLabel ' classVariableNames: '' module: #(Squeak Development FileList)! !B3DScene class methodsFor: 'class initialization' stamp: 'sw 2/17/2002 01:34'! serviceOpen3DSFile "Answer a service for opening 3-D scene file" ^ SimpleServiceEntry provider: self label: 'open 3DS file' selector: #open3DSFile: description: 'open a 3-D scene file' buttonLabel: 'open'! ! !CRRecognizer class methodsFor: 'class initialization' stamp: 'sw 2/17/2002 02:36'! serviceLoadGenieDisplay "Answer a service for opening in a Genie Display Properties" ^ SimpleServiceEntry provider: self label: 'load Genie Display Properties' selector: #loadCRDisplayProperties: description: 'load Genie Display Properties' buttonLabel: 'load'! ! !CRRecognizer class methodsFor: 'class initialization' stamp: 'sw 2/17/2002 02:35'! serviceLoadGenieGesture "Answer a service for loading a Genie gesture dictionary" ^ SimpleServiceEntry provider: self label: 'load Genie Gesture Dictionary' selector: #loadCRDictionary: description: 'load Genie Gesture Dictionary' buttonLabel: 'load'! ! !ChangeList class methodsFor: 'fileIn/Out' stamp: 'sw 2/17/2002 00:13'! serviceBrowseChangeFile "Answer a service for opening a changelist browser on a file" ^ SimpleServiceEntry provider: self label: 'changelist browser' selector: #browseChangesFile: description: 'open a changelist tool on this file' buttonLabel: 'changes'! ! !ChangeSorter class methodsFor: 'fileIn/Out' stamp: 'sw 2/16/2002 01:31'! fileIntoNewChangeSet: fullName "File in all of the contents of the currently selected file, if any, into a new change set." | fn ff | fullName ifNil: [^ self beep]. ff _ FileStream readOnlyFileNamed: (fn _ GZipReadStream uncompressedFileName: fullName). ((FileDirectory extensionFor: fn) sameAs: 'html') ifTrue: [ff _ ff asHtml]. self newChangesFromStream: ff named: (FileDirectory localNameFor: fn)! ! !ChangeSorter class methodsFor: 'fileIn/Out' stamp: 'sw 2/17/2002 01:36'! serviceFileIntoNewChangeSet "Answer a service for installing a file into a new change set" ^ SimpleServiceEntry provider: self label: 'install into new change set' selector: #fileIntoNewChangeSet: description: 'install the file as a body of code in the image: create a new change set and file-in the selected file into it' buttonLabel: 'install'! ! !DummyToolWorkingWithFileList class methodsFor: 'class initialization' stamp: 'sw 2/17/2002 02:36'! serviceLoadAFilForDummyTool "Answer a service for opening the Dummy tool" ^ SimpleServiceEntry provider: self label: 'menu label' selector: #loadAFileForTheDummyTool: description: 'Menu label for dummy tool' buttonLabel: 'test'! ! !FileContentsBrowser class methodsFor: 'instance creation' stamp: 'sw 2/16/2002 01:21'! browseFile: aFilename "Open a file contents browser on a file of the given name" aFilename ifNil: [^ self beep]. self browseFiles: (Array with: aFilename)! ! !FileContentsBrowser class methodsFor: 'instance creation' stamp: 'sw 2/17/2002 01:36'! serviceBrowseCode "Answer the service of opening a file-contents browser" ^ SimpleServiceEntry provider: self label: 'code-file browser' selector: #browseFile: description: 'open a "file-contents browser" on this file, allowing you to view and selectively load its code' buttonLabel: 'code'! ! !FileDirectory methodsFor: 'file name utilities' stamp: 'sw 2/17/2002 02:32'! fullNameFor: fileName "Return a corrected, fully-qualified name for the given file name. If the given name is already a full path (i.e., it contains a delimiter character), assume it is already a fully-qualified name. Otherwise, prefix it with the path to this directory. In either case, correct the local part of the file name." "Details: Note that path relative to a directory, such as '../../foo' are disallowed by this algorithm. Also note that this method is tolerent of a nil argument -- is simply returns nil in this case." | correctedLocalName prefix | fileName ifNil: [^ nil]. self class splitName: fileName to: [:filePath :localName | correctedLocalName _ localName isEmpty ifFalse: [self checkName: localName fixErrors: true] ifTrue: [localName]. prefix _ self fullPathFor: filePath]. prefix isEmpty ifTrue: [^correctedLocalName]. prefix last = self pathNameDelimiter ifTrue:[^ prefix, correctedLocalName] ifFalse:[^ prefix, self slash, correctedLocalName]! ! !FileList methodsFor: 'initialization' stamp: 'sw 2/17/2002 02:40'! dynamicButtonServices "Answer services for buttons that may come and go in the button pane, depending on selection" ^ fileName isEmptyOrNil ifTrue: [#()] ifFalse: [self itemsForFile: self fullName]! ! !FileList methodsFor: 'initialization' stamp: 'sw 2/17/2002 05:39'! optionalButtonRow "Answer the button row associated with a file list" | aRow aButton selectorsWithArgsSelector| aRow _ AlignmentMorph newRow beSticky. aRow color: Color transparent. aRow clipSubmorphs: true. aRow layoutInset: 5@1; cellInset: 6. self universalButtonServices do: "just the three sort-by items" [:service | aButton := PluggableButtonMorph on: service provider getState: nil action: service selector. aButton color: Color transparent; hResizing: #spaceFill; vResizing: #spaceFill; useRoundedCorners; label: service buttonLabel asString; askBeforeChanging: true; onColor: Color transparent offColor: Color transparent. aRow addMorphBack: aButton. aButton setBalloonText: service description. (service selector == #sortBySize) ifTrue: [aRow addTransparentSpacerOfSize: (4@0)]]. aRow setNameTo: 'buttons'. aRow setProperty: #buttonRow toValue: true. "Used for dynamic retrieval later on" ^ aRow ! ! !FileList methodsFor: 'initialization' stamp: 'sw 2/17/2002 05:35'! optionalButtonServices "Answer a list of services underlying the optional buttons in their initial inception. For the moment, only the sorting buttons are shown." ^ {self serviceSortByName. self serviceSortByDate. self serviceSortBySize}! ! !FileList methodsFor: 'initialization' stamp: 'sw 2/17/2002 00:07'! optionalButtonSpecs "Answer a list of services underlying the optional buttons in their initial inception." ^ {self serviceSortByName. self serviceSortByDate. self serviceSortBySize}! ! !FileList methodsFor: 'initialization' stamp: 'sw 2/17/2002 05:39'! optionalButtonView "Answer a view of optional buttons" | aView bHeight windowWidth offset previousView aButtonView wid services sel allServices | aView _ View new model: self. bHeight _ self optionalButtonHeight. windowWidth _ 120. aView window: (0 @ 0 extent: windowWidth @ bHeight). offset _ 0. allServices _ self universalButtonServices. services _ allServices copyFrom: 1 to: (allServices size min: 5). previousView _ nil. services do: [:service | sel _ service selector. aButtonView _ sel asString numArgs = 0 ifTrue: [PluggableButtonView on: service provider getState: (service extraSelector == #none ifFalse: [service extraSelector]) action: sel] ifFalse: [PluggableButtonView on: service provider getState: (service extraSelector == #none ifFalse: [service extraSelector]) action: sel getArguments: #fullName from: self]. service selector = services last selector ifTrue: [wid _ windowWidth - offset] ifFalse: [aButtonView borderWidthLeft: 0 right: 1 top: 0 bottom: 0. wid _ windowWidth // services size - 2]. aButtonView label: service buttonLabel asParagraph; window: (offset @ 0 extent: wid @ bHeight). offset _ offset + wid. service selector = services first selector ifTrue: [aView addSubView: aButtonView] ifFalse: [aView addSubView: aButtonView toRightOf: previousView]. previousView _ aButtonView]. ^ aView! ! !FileList methodsFor: 'initialization' stamp: 'sw 2/15/2002 18:21'! serviceSelectorsForButtonPane "Answer a list of service selectors the user wants to have offered in the optional button pane of a fileList. Users can change this to suit personal needs" ^ #(fileIntoNewChangeSet: browseFile: browseCode: browseChangesFile:)! ! !FileList methodsFor: 'initialization' stamp: 'sw 2/17/2002 05:38'! universalButtonServices "Answer a list of services underlying the universal buttons in their initial inception. For the moment, only the sorting buttons are shown." ^ {self serviceSortByName. self serviceSortByDate. self serviceSortBySize}! ! !FileList methodsFor: 'initialization' stamp: 'sw 2/17/2002 05:30'! updateButtonRow "Dynamically update the contents of the button row, if any." | aWindow aRow aButton | Smalltalk isMorphic ifFalse: [^ self]. aWindow _ self dependents detect: [:m | (m isKindOf: SystemWindow) and: [m model == self]] ifNone: [^ self]. aRow _ aWindow findDeepSubmorphThat: [:m | m hasProperty: #buttonRow] ifAbsent: [^ self]. (aRow submorphs size - 4) timesRepeat: [aRow submorphs last delete]. self dynamicButtonServices do: [:service | aButton _ PluggableButtonMorph on: service provider getState: nil action: service selector. aButton argumentsProvider: self argumentsSelector: #fullNameArguments. aButton color: Color transparent; hResizing: #spaceFill; vResizing: #spaceFill; useRoundedCorners; label: service buttonLabel asString; askBeforeChanging: true; onColor: Color transparent offColor: Color transparent. aRow addMorphBack: aButton. aButton setBalloonText: service description]! ! !FileList methodsFor: 'file list' stamp: 'sw 2/17/2002 02:32'! fileListIndex: anInteger "Select the file name having the given index, and display its contents." | item name | self okToChange ifFalse: [^ self]. listIndex := anInteger. listIndex = 0 ifTrue: [fileName := nil] ifFalse: [item := self fileNameFromFormattedItem: (list at: anInteger). (item endsWith: self folderString) ifTrue: ["remove [...] folder string and open the folder" name := item copyFrom: 1 to: item size - self folderString size. listIndex := 0. brevityState := #FileList. self addPath: name. name first = $^ ifTrue: [self directory: (ServerDirectory serverNamed: name allButFirst)] ifFalse: [volListIndex = 1 ifTrue: [name _ name, directory slash]. self directory: (directory directoryNamed: name)]] ifFalse: [fileName := item]]. "open the file selected" brevityState := #needToGetBrief. self changed: #fileListIndex. self changed: #contents. self updateButtonRow! ! !FileList methodsFor: 'file list menu' stamp: 'sw 2/16/2002 00:08'! fileContentsMenu: aMenu shifted: shifted "Construct aMenu to have items appropriate for the file browser's code pane, given the shift state provided" | shiftMenu services maybeLine extraLines | shifted ifTrue: [shiftMenu _ ParagraphEditor shiftedYellowButtonMenu. ^ aMenu labels: shiftMenu labelString lines: shiftMenu lineArray selections: shiftMenu selections]. fileName ifNotNil: [services _ OrderedCollection new. (#(briefHex briefFile needToGetBriefHex needToGetBrief) includes: brevityState) ifTrue: [services add: self serviceGet]. (#(fullHex briefHex needToGetFullHex needToGetBriefHex) includes: brevityState) ifFalse: [services add: self serviceGetHex]. maybeLine _ services size. (#('st' 'cs') includes: self suffixOfSelectedFile) ifTrue: [services addAll: (self servicesFromSelectorSpecs: #(fileIntoNewChangeSet: fileIn: browseChangesFile: browseFile:))]. extraLines _ OrderedCollection new. maybeLine > 0 ifTrue: [extraLines add: maybeLine]. services size > maybeLine ifTrue: [extraLines add: services size]. aMenu addServices: services for: self fullName extraLines: extraLines]. aMenu addList: #( ('find...(f)' find) ('find again (g)' findAgain) ('set search string (h)' setSearchString) - ('do again (j)' again) ('undo (z)' undo) - ('copy (c)' copySelection) ('cut (x)' cut) ('paste (v)' paste) ('paste...' pasteRecent) - ('do it (d)' doIt) ('print it (p)' printIt) ('inspect it (i)' inspectIt) ('fileIn selection (G)' fileItIn) - ('accept (s)' accept) ('cancel (l)' cancel) - ('more...' shiftedYellowButtonActivity)). ^ aMenu! ! !FileList methodsFor: 'file list menu' stamp: 'sw 2/16/2002 01:35'! fullFileListMenu: aMenu shifted: aBoolean "Fill the menu with all possible items for the file list pane, regardless of selection." | services servicesPlus extraLines linePointer | aMenu title: 'all possible file operations'. servicesPlus := self servicesFromSelectorSpecs: #( openImageInWindow: importImage: openAsBackground: - fromFileName: openFromFile: - openOn: fileIntoNewChangeSet: fileIn: browseChangesFile: putUpdate: - playMidiFile: openAsMovie: openAsFlash: openTTFFile: open3DSFile: openTapeFromFile: openVRMLFile: - viewContents: saveContents: openOn: - removeLineFeeds: renderFile: - loadCRDictionary: loadCRDisplayProperties: ). extraLines _ OrderedCollection new. linePointer _ 1. services _ OrderedCollection new. servicesPlus doWithIndex: [:svc :ind | svc == #- ifTrue: [extraLines add: linePointer - 1] ifFalse: [services add: svc. linePointer _ linePointer + 1]]. aMenu addServices: services for: self fullName extraLines: extraLines! ! !FileList methodsFor: 'file list menu' stamp: 'sw 2/17/2002 00:57'! fullNameArguments "Answer a collection consisting of the full name of my currently-selected file" ^ {self fullName}! ! !FileList methodsFor: 'file list menu' stamp: 'sw 2/16/2002 01:40'! itemsForFile: fullName "Answer a list of services appropriate for a file of the given full name" | services suffix | suffix _ self suffixOfSelectedFile. services _ OrderedCollection new. self registeredFileReaderClasses do: [:reader | reader ifNotNil: [services addAll: (reader fileReaderServicesForFile: fullName suffix: suffix)]]. ^ services, (self myServicesForFile: fullName suffix: suffix)! ! !FileList methodsFor: 'file list menu' stamp: 'sw 2/15/2002 23:19'! suffixOfSelectedFile "Answer the file extension of the receiver's selected file" | aName | ^ (aName _ self fullName) ifNil: [''] ifNotNil: [(FileDirectory extensionFor: aName) asLowercase]! ! !FileList methodsFor: 'own services' stamp: 'sw 2/15/2002 19:07'! serviceAddNewDirectory "Answer a service entry characterizing the 'add new directory' command" ^ SimpleServiceEntry provider: self label: 'add new directory' selector: #addNewDirectory description: 'adds a new, empty directory (folder)' ! ! !FileList methodsFor: 'own services' stamp: 'sw 2/11/2002 23:36'! serviceAddNewFile "Answer a service entry characterizing the 'add new file' command" ^ SimpleServiceEntry provider: self label: 'add new file' selector: #addNewFile description: 'create a new,. empty file, and add it to the current directory.'! ! !FileList methodsFor: 'own services' stamp: 'sw 2/17/2002 01:36'! serviceBroadcastUpdate "Answer a service for broadcasting a file as an update" ^ SimpleServiceEntry provider: self label: 'broadcast as update' selector: #putUpdate: description: 'broadcast file as update' buttonLabel: 'broadcast'! ! !FileList methodsFor: 'own services' stamp: 'sw 2/17/2002 02:36'! serviceCompressFile "Answer a service for compressing a file" ^ SimpleServiceEntry provider: self label: 'compress' selector: #compressFile description: 'compress file' buttonLabel: 'compress'! ! !FileList methodsFor: 'own services' stamp: 'sw 2/16/2002 01:39'! serviceGet "Answer a service for getting the entire file" ^ (SimpleServiceEntry provider: self label: 'get entire file' selector: #get description: 'if the file has only been partially read in, because it is very large, read the entire file in at this time.')! ! !FileList methodsFor: 'own services' stamp: 'sw 2/16/2002 01:39'! serviceSortByDate "Answer a service for sorting by date" ^ (SimpleServiceEntry new provider: self label: 'by date' selector: #sortByDate description: 'sort entries by date') extraSelector: #sortingByDate; buttonLabel: 'date'! ! !FileList methodsFor: 'own services' stamp: 'sw 2/16/2002 01:39'! serviceSortByName "Answer a service for soring by name" ^ (SimpleServiceEntry new provider: self label: 'by name' selector: #sortByName description: 'sort entries by name') extraSelector: #sortingByName; buttonLabel: 'name'! ! !FileList methodsFor: 'own services' stamp: 'sw 2/16/2002 01:40'! serviceSortBySize "Answer a service for sorting by size" ^ (SimpleServiceEntry provider: self label: 'by size' selector: #sortBySize description: 'sort entries by size') extraSelector: #sortingBySize; buttonLabel: 'size'! ! !FileList methodsFor: 'own services' stamp: 'sw 2/15/2002 20:19'! servicesFromSelectorSpecs: symbolArray "Answer an array of services represented by the incoming symbols, eliminating any that do not have a currently-registered service. Pass the symbol #- along unchanged to serve as a separator between services" "FileList new servicesFromSelectorSpecs: #(fileIn: fileIntoNewChangeSet: browseChangesFile:)" | res services col | col := OrderedCollection new. services := self class allRegisteredServices, (self myServicesForFile: #dummy suffix: '*'). symbolArray do: [:sel | sel == #- ifTrue: [col add: sel] ifFalse: [res := services detect: [:each | each selector = sel] ifNone: [nil]. res notNil ifTrue: [col add: res]]]. ^ col! ! !FileList2 class methodsFor: 'button specs' stamp: 'sw 2/16/2002 01:37'! specsForImageViewer "A method of RAA's, seemingly unsent nowadays. Modified to use the wording 'graphic', in comformity with changes made elsewhere" ^ #( ('Name' sortByName sortingByName 'sort entries by name') ('Date' sortByDate sortingByDate 'sort entries by date') ('Size' sortBySize sortingBySize 'sort entries by size') ('View' openImageInWindow none 'open graphic in a window') ('Import' importImage none 'read graphic into ImageImports') ('Bgnd' openAsBackground none 'open graphic as background') )! ! !FileStream class methodsFor: 'file reader services' stamp: 'sw 2/17/2002 05:07'! fileIn: fullName "File in the entire contents of the file specified by the name provided" | fn ff | fullName ifNil: [^ self beep]. ff _ self readOnlyFileNamed: (fn _ GZipReadStream uncompressedFileName: fullName). ((FileDirectory extensionFor: fn) sameAs: 'html') ifTrue: [ff _ ff asHtml]. ff fileIn! ! !FileStream class methodsFor: 'file reader services' stamp: 'sw 2/17/2002 00:03'! fileReaderServicesForFile: fullName suffix: suffix "Answer services for the given file" ^ (self isSourceFileSuffix: suffix) ifTrue: [{self serviceRemoveLineFeeds. self serviceFileIn}] ifFalse: [#()]! ! !FileStream class methodsFor: 'file reader services' stamp: 'sw 2/17/2002 01:38'! serviceFileIn "Answer a service for filing in an entire file" ^ SimpleServiceEntry provider: self label: 'fileIn entire file' selector: #fileIn: description: 'file in the entire contents of the file, which is expected to contain Smalltalk code in fileout ("chunk") format' buttonLabel: 'filein'! ! !FileStream class methodsFor: 'file reader services' stamp: 'sw 2/16/2002 23:43'! serviceRemoveLineFeeds "Answer a service for removing linefeeds from a file" ^ SimpleServiceEntry provider: self label: 'remove line feeds' selector: #removeLineFeeds: description: 'remove line feeds in file' buttonLabel: 'remove lfs'! ! !FlashMorphReader class methodsFor: 'read Flash file' stamp: 'sw 2/17/2002 02:42'! serviceOpenAsFlash "Answer a service for opening a flash file" ^ SimpleServiceEntry provider: self label: 'open as Flash' selector: #openAsFlash: description: 'open file as flash' buttonLabel: 'open'! ! !Form class methodsFor: 'fileIn/Out' stamp: 'sw 2/17/2002 01:38'! serviceImageAsBackground "Answer a service for setting the desktop background from a given graphical file's contents" ^ SimpleServiceEntry provider: self label: 'use graphic as background' selector: #openAsBackground: description: 'use the graphic as the background for the desktop' buttonLabel: 'background'! ! !Form class methodsFor: 'fileIn/Out' stamp: 'sw 2/17/2002 01:39'! serviceImageImports "Answer a service for reading a graphic into ImageImports" ^ SimpleServiceEntry provider: self label: 'read graphic into ImageImports' selector: #importImage: description: 'Load a graphic, placing it in the ImageImports repository.' buttonLabel: 'import'! ! !Form class methodsFor: 'fileIn/Out' stamp: 'sw 2/17/2002 00:31'! serviceOpenImageInWindow "Answer a service for opening a graphic in a window" ^ SimpleServiceEntry provider: self label: 'open graphic in a window' selector: #openImageInWindow: description: 'open a graphic file in a window' buttonLabel: 'open'! ! !Morph class methodsFor: 'fileIn/Out' stamp: 'sw 2/17/2002 02:43'! serviceLoadMorphFromFile "Answer a service for loading a .morph file" ^ SimpleServiceEntry provider: self label: 'load as morph' selector: #fromFileName: description: 'load as morph' buttonLabel: 'load'! ! !ArchiveViewer class methodsFor: 'class initialization' stamp: 'sw 2/17/2002 02:35'! serviceAddToNewZip "Answer a service for adding the file to a new zip" ^ SimpleServiceEntry provider: self label: 'add file to new zip' selector: #addFileToNewZip: description: 'add file to new zip' buttonLabel: 'to new zip'! ! !ArchiveViewer class methodsFor: 'class initialization' stamp: 'sw 2/17/2002 02:35'! serviceOpenInZipViewer "Answer a service for opening in a zip viewer" ^ SimpleServiceEntry provider: self label: 'open in zip viewer' selector: #openOn: description: 'open in zip viewer' buttonLabel: 'open zip'! ! !MoviePlayerMorph class methodsFor: 'fileIn/Out' stamp: 'sw 2/17/2002 01:23'! serviceOpenAsMovie "Answer a service for opening a file as a movie" ^ SimpleServiceEntry provider: self label: 'open as movie' selector: #openAsMovie: description: 'open file as movie' buttonLabel: 'open'! ! !ProjectViewMorph class methodsFor: 'project window creation' stamp: 'sw 2/17/2002 02:43'! serviceOpenProjectFromFile "Answer a service for opening a .pr project file" ^ SimpleServiceEntry provider: self label: 'load as project' selector: #openFromFile: description: 'open project from file' buttonLabel: 'load'! ! !Scamper class methodsFor: 'instance creation' stamp: 'sw 2/17/2002 02:45'! serviceOpenInWebBrowser "Answer a service for opening a web browser on a file" ^ SimpleServiceEntry provider: self label: 'open in web browser' selector: #openFile: description: 'open in web browser' buttonLabel: 'open'! ! !ScorePlayerMorph class methodsFor: 'class initialization' stamp: 'sw 2/17/2002 02:45'! servicePlayMidiFile "Answer a service for opening player on a midi file" ^ SimpleServiceEntry provider: self label: 'open in midi player' selector: #playMidiFile: description: 'open the midi-player tool on this file' buttonLabel: 'open'! ! !SimpleServiceEntry methodsFor: 'accessing' stamp: 'sw 2/15/2002 17:53'! buttonLabel "Answer the label to be emblazoned on a button representing the service in a file list, for example" ^ buttonLabel ifNil: [label]! ! !SimpleServiceEntry methodsFor: 'accessing' stamp: 'sw 2/15/2002 17:54'! buttonLabel: aString "Set the receiver's buttonLabel, to be used on a button in a tool-pane; this is split out so that a more abbreviated wording can be deployed if desired" buttonLabel _ aString! ! !SimpleServiceEntry class methodsFor: 'instance creation' stamp: 'sw 2/17/2002 02:48'! provider: anObject label: aString selector: aSymbol description: anotherString buttonLabel: aLabel "Answer a new service object with the given initializations. This variant allows a custom button label to be provided, in order to preserve precious horizontal real-estate in the button pane, while still allowing more descriptive wordings in the popup menu" ^ self new provider: anObject label: aString selector: aSymbol description: anotherString; buttonLabel: aLabel; yourself! ! !Wonderland class methodsFor: 'fileIn/Out' stamp: 'sw 2/17/2002 02:49'! serviceOpenInWonderland "Answer a service for opening a file in Wonderland" ^ SimpleServiceEntry provider: self label: 'open in Wonderland' selector: #openVRMLFile: description: 'open in Wonderland' buttonLabel: 'open'! ! !Wonderland class methodsFor: 'fileIn/Out' stamp: 'sw 2/17/2002 02:48'! serviceOpenModelInEditor "Answer a service for opening an alice model in an editor" ^ SimpleServiceEntry provider: self label: 'open model in editor' selector: #openModelIntoAlice: description: 'open model in editor' buttonLabel: 'open'! ! FileList class removeSelector: #servicesFromSelectorSpecs:! FileList removeSelector: #buttonRowForCurrentSelection! FileList removeSelector: #dynamicButtonSpecs! FileList removeSelector: #update:!