'From Squeak3.2alpha of 1 November 2001 [latest update: #4599] on 12 December 2001 at 12:32 pm'! "Change Set: regFileList-hgglsd Date: 10 November 2001 Author: Henrik Gedenryd, Gerald Leeb and Stephane Ducasse Derived from 4684bRegFileList-hgglsd.cs from Squeak 3.3a. Special version sw 11/2/2002 21:56 for porting forward to 3.4: removes the ModuleInstaller method, removes #initializeZipFileContents. custom rewrite of #removeFromSystem: remove FileList copyName (had bug) Version 3.0 - 16 Nov 2001 Prerequisites: HookForRemoveFromSystem.cs version 1. SUnit any version This changeset introduces an important architectural change in the design of the FileList. The FileList now proposes a registration mechanism to which any tools the filelist use ***MUST*** register. This way it is possible to load dynamically a new tool or unload and to have the FileList automatically updated. This change supports a decomposition of Squeak and removes problem with dead reference to classes after a major shrink. Tools should implement the method fileReaderServicesForSuffix: suffix (look for sender in the image) and register to the FileList calling the class method registerFileReader: aProvider when they load in. There is a testSuite called FileListTest that presents some example. A tool register by providing a SimpleEntryService. It is composed by a class, a menu label and a method selector having one argument. See example below. The convention right now is that the argument is the path of the selected file when one file is selected and the fileList itself when no file is selected. It seems an arbitrary choice but this is the one that avoid to declare method with explicit reference to file list in reader. Hence decouple the most the reader and the file list. Note that this regsitration mechanism relies on the fact that the file list is on the image. In the future we may introduce another object that we know will be always in the image. To do list: look for - self flag: #shouldBeChangedToReflectThatToolsCanBeRemoved. - self flag: #ViolateNonReferenceToOtherClasses. stef History: Stef 10 November 2001. - documented and edited the preamble + class comment. - Added the possibility to unregister a tool, to check if a given tool was registered. This help to build default menu. - remove a bug with browseFile. Now we can also selectAndBrowse file when no file are selected in a way enforced by the registration mechanism. - Remove one possible bug the class variable was lazzily accessed from the class side but there was an instance methods returned it directly. This would have returned nil instead of an empty collection. - renamed some methods to use the same vocabulary - fixed genie registration. Now genie uses the registration mechanism too. - fixed zipArchive registration - fixed alice registration - removing a class form the image also unregisters the tools for that purpose I introduced a hook method in the Class>>removeFromSystem: that per default does nothing. But using this hook instead of specializing removeFromSystem: does not let the responsibility to the class developer to call super removeFromSystem: To do: Check all the code and add some flag: method to indicate future work to do. check for example flag: #ViolateNonReferenceToOtherClasses and shouldBeChangedToReflectThatToolsCanBeRemoved - For example, some classes like ServerDirectory are still directly referenced via menu action. They could be the target of another iteration. Example: The method FileList>>itemsForFileEnding: retrieves the menu entries via ReaderServices. Each class can register itself as ReaderService with: FileList registerFileReader: self. The FileList collects the service entries for a file suffix by the message #fileReaderServicesForSuffix: of each ReaderService. Example: FlashMorphReader>>fileReaderServicesForSuffix: suffix ^ (suffix = 'swf') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'open as Flash' selector: #openAsFlash:}] ifFalse: [#()]"! !Class methodsFor: 'initialize-release' stamp: 'hg 12/12/2001 12:00'! unload "Sent when a the class is removed. Does nothing, but may be overridden by (class-side) subclasses." ! ! !Class methodsFor: 'initialize-release' stamp: 'hg 10/30/2001 13:38'! deactivate "A remnant from the 3.3a modules work, retained . Does nothing, but may be overridden in Metaclasses."! ! Object subclass: #DummyToolWorkingWithFileList instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Development-FileList-Test'! !DummyToolWorkingWithFileList commentStamp: 'sd and hg' prior: 0! I'm a dummy class for testing that the registration of the tool to the FileList of actually happens. In the future the tests should cover that the class register when loaded in memory and unregister when unloaded.! StringHolder subclass: #FileList instanceVariableNames: 'fileName directory volList volListIndex list listIndex pattern sortMode brevityState ' classVariableNames: 'FileReaderRegistry RecentDirs ' poolDictionaries: '' category: 'Development-FileList'! !Class methodsFor: 'initialize-release' stamp: 'sw 11/2/2002 22:46'! removeFromSystem: logged "Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver." "tell class to deactivate and unload itself-- two separate events in the module system" self deactivate; unload. self superclass ifNotNil: ["If we have no superclass there's nothing to be remembered" self superclass addObsoleteSubclass: self]. Smalltalk removeClassFromSystem: self logged: logged. self obsolete! ! !FileList commentStamp: '' prior: 0! I am model that can be used to navigate the host file system. By omitting the volume list, file list, and template panes from the view, I can also be used as the model for an editor on an individual file. The FileList now proposes a registration mechanism to which any tools the filelist use ***MUST*** register. This way it is possible to load dynamically a new tool or unload and to have the FileList automatically updated. This change supports a decomposition of Squeak and removes problem with dead reference to classes after a major shrink. Tools should implement the method fileReaderServicesForSuffix: suffix (look for sender in the image) and register to the FileList calling the class method registerFileReader: aProvider when they load in. There is a testSuite called FileListTest that presents some example. A tool register by providing a SimpleEntryService. It is composed by a class, a menu label and a method selector having one argument. From the code I deduced that this argument will be a string representing the full name of a file when one is selected or the file list itself when there is no selected file. Stef (I do not like really this distinction passing always a file list could be better) Old Comments: FileLists can now see FTP servers anywhere on the net. In the volume list menu: fill in server info... Gives you a form to register a new ftp server you want to use. open server... Choose a server to connect to. local disk Go back to looking at your local volume. Still undone (you can contribute code): [ ] Using a Proxy server to get out through a firewall. What is the convention for proxy servers with FTP? [ ] Fill in the date and size info in the list of remote files. Allow sorting by it. New smarts needed in (ServerDirectory fileNameFormattedFrom:sizePad:sortMode:). [ ] Currently the FileList has no way to delete a directory. Since you can't select a directory without going into it, it would have to be deleting the current directory. Which would usually be empty. ! TestCase subclass: #FileListTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Development-FileList-Test'! Object subclass: #SimpleServiceEntry instanceVariableNames: 'provider label selector useLineAfter ' classVariableNames: '' poolDictionaries: '' category: 'Development-FileList'! !B3DScene class methodsFor: 'instance creation' stamp: 'hg 8/3/2000 16:09'! open3DSFile: fullFileName "Open a MoviePlayerMorph on the given file (must be in .3ds format)." | scene | scene _ B3DScene from3DS: (ThreeDSParser parseFileNamed: fullFileName). (B3DPrimitiveEngine isAvailable) ifFalse:[ (self confirm:'WARNING: YOU HAVE NO REAL SUPPORT FOR 3D!! Opening this guy in Morphic will EXTREMELY time consuming. Are you sure you want to do this?!! (NO is probably the right answer :-)') ifFalse:[^scene inspect]]. scene defaultCamera moveToFit: scene. (B3DSceneMorph new scene: scene) openInWorld.! ! !B3DScene class methodsFor: 'class initialization' stamp: 'hg 8/3/2000 16:08'! fileReaderServicesForSuffix: suffix ^(suffix = '3ds') | (suffix = '*') ifTrue: [{SimpleServiceEntry provider: self label: 'Open 3DS file' selector: #open3DSFile:}] ifFalse: [#()] ! ! !B3DScene class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 21:42'! initialize FileList registerFileReader: self! ! !B3DScene class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:20'! unload FileList unregisterFileReader: self ! ! !CRRecognizer class methodsFor: 'class initialization' stamp: 'SD 11/11/2001 10:56'! fileReaderServicesForSuffix: suffix ^ (suffix = 'ggd') ifTrue: [ {SimpleServiceEntry provider: self label: 'load Genie Gesture Dictionary' selector: #loadCRDictionary:}] ifFalse: [suffix = 'gdp' ifTrue: [ {SimpleServiceEntry provider: self label: 'load Genie Display Properties' selector: #loadCRDisplayProperties: } ] ifFalse: [#()]] ! ! !CRRecognizer class methodsFor: 'class initialization' stamp: 'SD 11/10/2001 18:21'! initialize FileList registerFileReader: self! ! !CRRecognizer class methodsFor: 'class initialization' stamp: 'SD 11/10/2001 18:35'! loadCRDictionary: fullName | morph | Smalltalk isMorphic ifFalse: [self beep. ^ self inform: 'Only available within morphic']. morph _ CRDictionary instanceBrowser newMorphWithFileNamed: fullName. (CRDictionary instanceBrowser isOpenInWorld: World) ifTrue: [morph delete] ifFalse: [morph openInWorld].! ! !CRRecognizer class methodsFor: 'class initialization' stamp: 'SD 11/10/2001 18:37'! loadCRDisplayProperties: fullName | morph | Smalltalk isMorphic ifFalse: [self beep. ^ self inform: 'Only available within morphic']. morph _ CRDisplayProperties instanceBrowser newMorphWithFileNamed: fullName. (CRDisplayProperties instanceBrowser isOpenInWorld: World) ifTrue: [morph delete] ifFalse: [morph openInWorld].! ! !CRRecognizer class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:21'! unload FileList unregisterFileReader: self ! ! !ChangeList class methodsFor: 'initialize-release' stamp: 'hg 8/3/2000 18:14'! initialize FileList registerFileReader: self! ! !ChangeList class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 18:12'! browseChangesFile: fullName "Browse the selected file in fileIn format." fullName ifNotNil: [ChangeList browseStream: (FileStream oldFileNamed: fullName)] ifNil: [self beep]! ! !ChangeList class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 18:14'! fileReaderServicesForSuffix: suffix ^ (FileStream isSourceFileSuffix: suffix) ifTrue: [{SimpleServiceEntry provider: self label: 'browse as change list' selector: #browseChangesFile:}] ifFalse: [#()]! ! !ChangeList class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:21'! unload FileList unregisterFileReader: self ! ! !ChangeSorter class methodsFor: 'class initialization' stamp: 'LEG 10/24/2001 21:21'! initialize "Initialize the class variables" AllChangeSets == nil ifTrue: [AllChangeSets _ OrderedCollection new]. self gatherChangeSets. ChangeSetCategories ifNil: [self initializeChangeSetCategories]. RecentUpdateMarker _ 0. "ChangeSorter initialize" FileList registerFileReader: self ! ! !ChangeSorter class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:21'! unload FileList unregisterFileReader: self ! ! !ChangeSorter class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 18:06'! fileIntoNewChangeSet: fullName "File in all of the contents of the currently selected file, if any, into a new change set." | fn ff | 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: 'hg 8/3/2000 17:55'! fileReaderServicesForSuffix: suffix ^(suffix = 'st') | (suffix = 'cs') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'install into new change set' selector: #fileIntoNewChangeSet:}] ifFalse: [#()]! ! !DummyToolWorkingWithFileList class methodsFor: 'class initialization' stamp: 'SD 11/10/2001 21:27'! fileReaderServicesForSuffix: suffix ^ (suffix = 'kkk') ifTrue: [ {SimpleServiceEntry provider: self label: 'menu label for dummy tool' selector: #loadAFileForTheDummyTool:}] ifFalse: [#()] ! ! !DummyToolWorkingWithFileList class methodsFor: 'class initialization' stamp: 'SD 11/10/2001 21:48'! initialize "self initialize" FileList registerFileReader: self! ! !DummyToolWorkingWithFileList class methodsFor: 'class initialization' stamp: 'SD 11/14/2001 22:12'! loadAFileForTheDummyTool: aFileListOrAPath "attention. if the file list selects a file the argument will be a fullpath of the selected file else it will pass the filelist itself"! ! !DummyToolWorkingWithFileList class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:21'! unload FileList unregisterFileReader: self ! ! !DummyToolWorkingWithFileList class methodsFor: 'class initialization' stamp: 'SD 11/10/2001 21:49'! unregister FileList unregisterFileReader: self. ! ! !FileContentsBrowser class methodsFor: 'instance creation' stamp: 'hg 8/3/2000 18:17'! fileReaderServicesForSuffix: suffix ^(FileStream isSourceFileSuffix: suffix) ifTrue: [ {SimpleServiceEntry provider: self label: 'browse code' selector: #browseFile:}] ifFalse: [#()] ! ! !FileContentsBrowser class methodsFor: 'instance creation' stamp: 'SD 11/14/2001 22:13'! selectAndBrowseFile: aFileList "When no file are selected you can ask to browse several of them" | selectionPattern files | selectionPattern := FillInTheBlank request:'What files?' initialAnswer: aFileList pattern. files _ (aFileList directory fileNamesMatching: selectionPattern) collect: [:each | aFileList directory fullNameFor: each]. FileContentsBrowser browseFiles: files. ! ! !FileContentsBrowser class methodsFor: 'class initialization' stamp: 'hg 8/3/2000 18:17'! initialize FileList registerFileReader: self! ! !FileContentsBrowser class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:21'! unload FileList unregisterFileReader: self ! ! !FileList methodsFor: 'initialization' stamp: 'SD 11/8/2001 21:22'! modelWakeUp "User has entered or expanded the window -- reopen any remote connection." (directory isKindOf: ServerDirectory) ifTrue: [directory wakeUp] "It would be good to implement a null method wakeUp on the root of directory"! ! !FileList methodsFor: 'volume list and pattern' stamp: 'SD 11/11/2001 13:59'! directory ^ directory! ! !FileList methodsFor: 'apparently not called' stamp: 'SD 11/11/2001 14:19'! openArchiveViewer self flag: #ViolateNonReferenceToOtherClasses. "this method should be moved into the ArchiveViewer and the ArchiveViewer should register itself to the fileList" ArchiveViewer openOn: self fullName.! ! !FileList methodsFor: 'file menu action' stamp: 'SD 11/11/2001 14:21'! compressFile "Compress the currently selected file" "this method may be a problem in the future but it will depend on the way Stream and decomposed. It indirectly links Gzip to the fileList. Right now this is not a problem" (directory readOnlyFileNamed: self fullName) compressFile. self updateFileList! ! !FileList methodsFor: 'obsolete methods' stamp: 'SD 11/15/2001 22:01'! addFileToZip "Add the currently selected file to a new zip" | zip | self error: 'should not be used keep for temporary documentation'. self flag: #ViolateNonReferenceToOtherClasses. zip _ (ZipArchive new) addFile: self fullName as: fileName; yourself. (ArchiveViewer open) archive: zip! ! !FileList methodsFor: 'obsolete methods' stamp: 'SD 11/15/2001 22:02'! browseFiles | selectionPattern fileList | self error: 'should not be used keep for temporary documentation'. "sd: normally should not be called anymore" selectionPattern := FillInTheBlank request:'What files?' initialAnswer: self pattern. fileList _ (directory fileNamesMatching: selectionPattern) collect: [:each | directory fullNameFor: each]. self flag: #ViolateNonReferenceToOtherClasses. FileContentsBrowser browseFiles: fileList. ! ! !FileList methodsFor: 'obsolete methods' stamp: 'SD 11/15/2001 22:02'! loadCRDictionary | morph | self error: 'should not be used keep for temporary documentation'. Smalltalk isMorphic ifFalse: [self beep. ^ self inform: 'Only available within morphic']. morph _ CRDictionary instanceBrowser newMorphWithFileNamed: self fullName. (CRDictionary instanceBrowser isOpenInWorld: World) ifTrue: [morph delete] ifFalse: [morph openInWorld].! ! !FileList methodsFor: 'obsolete methods' stamp: 'SD 11/15/2001 22:02'! loadCRDisplayProperties | morph | self error: 'should not be used keep for temporary documentation'. Smalltalk isMorphic ifFalse: [self beep. ^ self inform: 'Only available within morphic']. self flag: #ViolateNonReferenceToOtherClasses. "Genie related" morph _ CRDisplayProperties instanceBrowser newMorphWithFileNamed: self fullName. (CRDisplayProperties instanceBrowser isOpenInWorld: World) ifTrue: [morph delete] ifFalse: [morph openInWorld].! ! !FileList methodsFor: 'obsolete methods' stamp: 'SD 11/15/2001 22:02'! openModelintoAlice "If a Wonderland exists, load this model into it as an actor. If it doesn't, make one first" | alice | self error: 'should not be used keep for temporary documentation'. Smalltalk isMorphic ifFalse: [^self error: 'Only works in Morphic - sorry!!']. alice _ World submorphs detect: [:m | m isKindOf: WonderlandEditor] ifNone: [nil]. alice isNil ifTrue: [alice := Wonderland new] ifFalse: [alice := alice getWonderland]. alice makeActorFrom: self fullName. ! ! !FileList methodsFor: 'to be transformed in registration' stamp: 'SD 11/10/2001 17:49'! askServerInfo "Get the user to create a ServerDirectory for a new server. Fill in and say Accept." | template | template _ '"Please fill in the following info, then select all text and choose DoIt." | aa | self flag: #ViolateNonReferenceToOtherClasses. aa _ ServerDirectory new. aa server: ''st.cs.uiuc.edu''. "host" aa user: ''anonymous''. aa password: ''yourEmail@school.edu''. aa directory: ''/Smalltalk/Squeak/Goodies''. aa url: ''''. "<- this is optional. Only used when *writing* update files." ServerDirectory addServer: aa named: ''UIUCArchive''. "<- known by this name in Squeak"'. (StringHolder new contents: template) openLabel: 'FTP Server Form' ! ! !FileList methodsFor: 'to be transformed in registration' stamp: 'SD 11/11/2001 13:32'! fileContentsMenu: aMenu shifted: shifted | shiftMenu | ^ shifted ifFalse: [aMenu labels: 'get entire file view as hex fileIn file into new change set browse changes browse code find...(f) find again (g) set search string (h) do again (j) undo (z) copy (c) cut (x) paste (v) paste... do it (d) print it (p) inspect it (i) accept (s) cancel (l) more...' lines: #(2 6 9 11 15 18 20) selections: #(get getHex fileInSelection fileIntoNewChangeSet browseChanges browseFile find findAgain setSearchString again undo copySelection cut paste pasteRecent doIt printIt inspectIt accept cancel shiftedYellowButtonActivity)] ifTrue: [shiftMenu _ ParagraphEditor shiftedYellowButtonMenu. aMenu labels: shiftMenu labelString lines: shiftMenu lineArray selections: shiftMenu selections] ! ! !FileList methodsFor: 'to be transformed in registration' stamp: 'SD 11/8/2001 20:30'! fullFileListMenu: aMenu shifted: aBoolean "Fill the menu with all possible items for the file list pane, regardless of selection." aMenu title: 'all possible file operations'. Smalltalk isMorphic ifTrue: [aMenu addStayUpItemSpecial]. self flag: #shouldBeChangedToReflectThatToolsCanBeRemoved. aMenu addList: #( ('open graphic in a window' openImageInWindow) ('read graphic into ImageImports' importImage) ('open graphic as background' openAsBackground) - ('load as morph' openMorphFromFile) ('load as project' openProjectFromFile) ('load as book' openBookFromFile) - ('play midi file' playMidiFile) ('open as movie' openAsMovie) ('open as Flash' openAsFlash) ('open true type font' openAsTTF) ('open 3DS file' open3DSFile) ('open for playback' openTapeFromFile) ('open in Wonderland' openVRMLFile) ('open in browser' openInBrowser) - ('fileIn' fileInSelection) ('file into new change set' fileIntoNewChangeSet) ('browse changes' browseChanges) ('browse code' browseFile) - ('view decompressed' viewGZipContents) ('decompress to file' saveGZipContents) - ('broadcast as update' putUpdate) ('remove line feeds' removeLinefeeds) ('generate HTML' renderFile) - ('load Genie Gesture Dictionary' loadCRDictionary) ('load Genie Display Properties' loadCRDisplayProperties))! ! !FileList methodsFor: 'to be transformed in registration' stamp: 'SD 11/11/2001 14:28'! putUpdate: fullFileName "Put this file out as an Update on the servers." | names choice | self canDiscardEdits ifFalse: [^ self changed: #flash]. names _ ServerDirectory groupNames asSortedArray. choice _ (SelectionMenu labelList: names selections: names) startUp. choice == nil ifTrue: [^ self]. (ServerDirectory groupNamed: choice) putUpdate: (directory oldFileNamed: fullFileName). self volumeListIndex: volListIndex. ! ! !FileList methodsFor: 'to be transformed in registration' stamp: 'SD 11/10/2001 17:49'! removeServer | choice names | self flag: #ViolateNonReferenceToOtherClasses. names := ServerDirectory serverNames asSortedArray. choice := (SelectionMenu labelList: names selections: names) startUp. choice == nil ifTrue: [^ self]. ServerDirectory removeServerNamed: choice! ! !FileList methodsFor: 'file list menu' stamp: 'LEG 10/24/2001 15:37'! fileListMenu: aMenu fileName ifNil: [^ self noFileSelectedMenu: aMenu] ifNotNil: [^ self fileSelectedMenu: aMenu]. ! ! !FileList methodsFor: 'file list menu' stamp: 'SD 11/14/2001 22:13'! fileSelectedMenu: aMenu | firstItems secondItems thirdItems n1 n2 n3 services | firstItems _ self itemsForFileEnding: (FileDirectory extensionFor: self fullName) asLowercase. secondItems _ self itemsForAnyFile. thirdItems _ self itemsForNoFile. n1 _ firstItems size. n2 _ n1 + secondItems size. n3 _ n2 + thirdItems size. services _ firstItems, secondItems, thirdItems, {SimpleServiceEntry provider: self label: 'more...' selector: #offerAllFileOptions}. ^ aMenu addServices: services for: self fullName extraLines: (Array with: n1 with: n2 with: n3) ! ! !FileList methodsFor: 'file list menu' stamp: 'SD 11/15/2001 22:03'! itemsForAnyFile "what's happen if the Zip stuff is not in the image?" | services | self flag: #possibleBug. services := OrderedCollection new: 5. services add: (SimpleServiceEntry provider: self label: 'copy name to clipboard' selector: #copyName). services add: (SimpleServiceEntry provider: self label: 'rename' selector: #renameFile). services add: (SimpleServiceEntry provider: self label: 'delete' selector: #deleteFile). services add: (SimpleServiceEntry provider: self label: 'compress' selector: #compressFile). (self class isReaderNamedRegistered: #ZipArchive) ifTrue: [ services add: (SimpleServiceEntry provider: (Smalltalk at: #ZipArchive) label: 'add file to zip' selector: #addFileToZip:)] . "this code shows that it would might be better to register the services than the classes" ^ services! ! !FileList methodsFor: 'file list menu' stamp: 'SD 11/8/2001 21:15'! itemsForFileEnding: suffix | services | services _ OrderedCollection new. self registeredFileReaderClasses do: [:reader | reader ifNotNil: [services addAll: (reader fileReaderServicesForSuffix: suffix)]]. ^services, (self myServicesForFileEnding: suffix). ! ! !FileList methodsFor: 'file list menu' stamp: 'SD 11/14/2001 22:06'! itemsForNoFile | services | services := OrderedCollection new: 6. services add: (SimpleServiceEntry provider: self label: 'sort by name' selector: #sortByName). services add: (SimpleServiceEntry provider: self label: 'sort by size' selector: #sortBySize). services add: ((SimpleServiceEntry provider: self label: 'sort by date' selector: #sortByDate) useLineAfter: true). (self isFileSelected not and: [self class isReaderNamedRegistered: #FileContentsBrowser]) ifTrue:[ services add: ((SimpleServiceEntry provider: FileContentsBrowser label: 'browse code files' selector: #selectAndBrowseFile:) useLineAfter: true)]. services add: (SimpleServiceEntry provider: self label: 'add new file' selector: #addNewFile). services add: (SimpleServiceEntry provider: self label: 'add new directory' selector: #addNewDirectory). ^ services ! ! !FileList methodsFor: 'file list menu' stamp: 'SD 11/8/2001 20:34'! myServicesForFileEnding: suffix ^(FileStream isSourceFileSuffix: suffix) ifTrue: [ {SimpleServiceEntry provider: self label: 'broadcast as update' selector: #putUpdate:}] ifFalse: [#()]! ! !FileList methodsFor: 'file list menu' stamp: 'SD 11/8/2001 20:34'! noFileSelectedMenu: aMenu ^ aMenu addServices: self itemsForNoFile for: self extraLines: #() ! ! !FileList methodsFor: 'private' stamp: 'SD 11/14/2001 21:59'! isFileSelected "return if a file is currently selected" ^ fileName isNil not! ! !FileList methodsFor: 'private' stamp: 'SD 11/8/2001 21:11'! registeredFileReaderClasses "return the list of classes that provide file reader services" ^ self class registeredFileReaderClasses! ! !FileList methodsFor: 'menu messages' stamp: 'SD 11/8/2001 20:21'! browseChanges "Browse the selected file in fileIn format." self flag: #ViolateNonReferenceToOtherClasses. ChangeList browseChangesFile: self fullName ! ! !FileList class methodsFor: 'instance creation' stamp: 'SD 11/8/2001 21:21'! openEditorOn: aFileStream editString: editString "Open an editor on the given FileStream." | fileModel topView fileContentsView | Smalltalk isMorphic ifTrue: [^ (self openMorphOn: aFileStream editString: editString) openInWorld]. fileModel _ FileList new setFileStream: aFileStream. "closes the stream" topView _ StandardSystemView new. topView model: fileModel; label: aFileStream fullName; minimumSize: 180@120. topView borderWidth: 1. fileContentsView _ PluggableTextView on: fileModel text: #contents accept: #put: readSelection: #contentsSelection menu: #fileContentsMenu:shifted:. fileContentsView window: (0@0 extent: 180@120). topView addSubView: fileContentsView. editString ifNotNil: [fileContentsView editString: editString. fileContentsView hasUnacceptedEdits: true]. topView controller open. ! ! !FileList class methodsFor: 'instance creation' stamp: 'SD 11/8/2001 21:20'! openFileDirectly | aResult | (aResult _ StandardFileMenu oldFile) ifNotNil: [self openEditorOn: (aResult directory readOnlyFileNamed: aResult name) editString: nil]! ! !FileList class methodsFor: 'class initialization' stamp: 'hg 8/6/2000 20:38'! initialize "FileList initialize" RecentDirs := OrderedCollection new. (Smalltalk allClassesImplementing: #fileReaderServicesForSuffix:) do: [:providerMetaclass | self registerFileReader: providerMetaclass soleInstance]! ! !FileList class methodsFor: 'file reader registration' stamp: 'SD 11/11/2001 13:53'! isReaderNamedRegistered: aSymbol "return if a given reader class has been registered. Note that this is on purpose that the argument is a symbol and not a class" ^ (self registeredFileReaderClasses collect: [:each | each name]) includes: aSymbol ! ! !FileList class methodsFor: 'file reader registration' stamp: 'SD 11/8/2001 21:17'! registerFileReader: aProviderClass "register the given class as providing services for reading files" | registeredReaders | registeredReaders := self registeredFileReaderClasses. (registeredReaders includes: aProviderClass) ifFalse: [ registeredReaders addLast: aProviderClass ]! ! !FileList class methodsFor: 'file reader registration' stamp: 'SD 11/8/2001 21:11'! registeredFileReaderClasses FileReaderRegistry ifNil: [FileReaderRegistry _ OrderedCollection new]. ^ FileReaderRegistry ! ! !FileList class methodsFor: 'file reader registration' stamp: 'SD 11/8/2001 21:18'! unregisterFileReader: aProviderClass "unregister the given class as providing services for reading files" self registeredFileReaderClasses remove: aProviderClass ifAbsent: [nil]! ! !FileList2 methodsFor: 'as yet unclassified' stamp: 'hg 8/3/2000 16:37'! importImage "Import the given image file and store the resulting Form in the global dictionary ImageImports, at a key consisting of the short filename up to the first period. " | key image | key _ fileName sansPeriodSuffix. image _ Form fromFileNamed: self fullName. Smalltalk imageImports at: key put: image. ! ! !FileList2 methodsFor: 'as yet unclassified' stamp: 'hg 8/3/2000 16:29'! openAsBackground "Set an image as a background image. Support Squeak's common file format (GIF, JPG, PNG, 'Form stoteOn: (run coded)' and BMP)" (Form fromFileNamed: self fullName) setAsBackground! ! !FileList2 methodsFor: 'as yet unclassified' stamp: 'hg 8/3/2000 16:34'! openImageInWindow "Handle five file formats: GIF, JPG, PNG, Form stoteOn: (run coded), and BMP. Fail if file format is not recognized." | image myStream | myStream _ (directory readOnlyFileNamed: fileName) binary. image _ Form fromBinaryStream: myStream. myStream close. Smalltalk isMorphic ifTrue: [(SketchMorph withForm: image) openInWorld] ifFalse: [FormView open: image named: fileName]! ! !FileList2 methodsFor: 'as yet unclassified' stamp: 'hg 8/3/2000 16:55'! openProjectFromFile "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world." Project canWeLoadAProjectNow ifFalse: [^ self]. ProjectViewMorph openFromDirectory: directory andFileName: fileName ! ! !FileListTest methodsFor: 'initialize' stamp: 'SD 11/10/2001 21:48'! setUp DummyToolWorkingWithFileList initialize.! ! !FileListTest methodsFor: 'initialize' stamp: 'SD 11/10/2001 21:49'! tearDown DummyToolWorkingWithFileList unregister.! ! !FileListTest methodsFor: 'private' stamp: 'SD 11/10/2001 22:05'! checkIsServiceIsFromDummyTool: service ^ (service instVarNamed: #provider) = DummyToolWorkingWithFileList & service label = 'menu label for dummy tool' & (service instVarNamed: #selector) = #loadAFileForTheDummyTool:! ! !FileListTest methodsFor: 'test' stamp: 'SD 11/10/2001 21:53'! testMenuReturned "(self selector: #testToolRegistered) debug" self assert: (FileList registeredFileReaderClasses includes: DummyToolWorkingWithFileList)! ! !FileListTest methodsFor: 'test' stamp: 'SD 11/10/2001 22:08'! testService "a stupid test to check that the class returns a service" "(self selector: #testService) debug" | services | services := (DummyToolWorkingWithFileList fileReaderServicesForSuffix: 'kkk') first. self assert: (self checkIsServiceIsFromDummyTool: services). services := (DummyToolWorkingWithFileList fileReaderServicesForSuffix: 'zkk'). self assert: services isEmpty! ! !FileListTest methodsFor: 'test' stamp: 'SD 11/10/2001 22:07'! testServicesForFileEnding "(self selector: #testServicesForFileEnding) debug" self assert: (self checkIsServiceIsFromDummyTool: (FileList new itemsForFileEnding: 'kkk') first). self assert: (FileList new itemsForFileEnding: 'zkk') isEmpty! ! !FileListTest methodsFor: 'test' stamp: 'SD 11/10/2001 21:52'! testToolRegistered "(self selector: #testToolRegistered) debug" self assert: (FileList registeredFileReaderClasses includes: DummyToolWorkingWithFileList)! ! !FileListTest methodsFor: 'test' stamp: 'SD 11/11/2001 13:54'! testToolRegisteredUsingInterface "(self selector: #testToolRegisteredUsingInterface) debug" self assert: (FileList isReaderNamedRegistered: #DummyToolWorkingWithFileList)! ! !FileStream class methodsFor: 'initialize-release' stamp: 'hg 8/3/2000 18:00'! initialize FileList registerFileReader: self! ! !FileStream class methodsFor: 'file reader services' stamp: 'hg 8/3/2000 18:06'! fileIn: fullName | fn ff | 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: 'hg 8/3/2000 18:27'! fileReaderServicesForSuffix: suffix ^(self isSourceFileSuffix: suffix) ifTrue: [ {SimpleServiceEntry provider: self label: 'fileIn' selector: #fileIn:. SimpleServiceEntry provider: self label: 'remove line feeds' selector: #removeLineFeeds:}] ifFalse: [#()] ! ! !FileStream class methodsFor: 'file reader services' stamp: 'hg 8/3/2000 18:13'! isSourceFileSuffix: suffix ^(suffix = 'st') | (suffix = 'cs') | (suffix = '*') ! ! !FileStream class methodsFor: 'file reader services' stamp: 'LEG 10/24/2001 23:35'! removeLineFeeds: fullName | fileContents | fileContents _ (CrLfFileStream readOnlyFileNamed: fullName) contentsOfEntireFile. (StandardFileStream newFileNamed: fullName) nextPutAll: fileContents; close.! ! !FileStream class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:21'! unload FileList unregisterFileReader: self ! ! !FlashMorphReader class methodsFor: 'class initialization' stamp: 'hg 8/1/2000 20:07'! initialize FileList registerFileReader: self! ! !FlashMorphReader class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:21'! unload FileList unregisterFileReader: self ! ! !FlashMorphReader class methodsFor: 'read Flash file' stamp: 'hg 8/3/2000 15:54'! fileReaderServicesForSuffix: suffix ^(suffix = 'swf') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'open as Flash' selector: #openAsFlash:}] ifFalse: [#()] ! ! !FlashMorphReader class methodsFor: 'read Flash file' stamp: 'hg 8/3/2000 16:04'! openAsFlash: fullFileName "Open a MoviePlayerMorph on the file (must be in .movie format)." | f player | f _ (FileStream readOnlyFileNamed: fullFileName) binary. player _ (FlashMorphReader on: f) processFile. player startPlaying. player open. ! ! !Form class methodsFor: 'initialize-release' stamp: 'hg 8/3/2000 16:25'! initialize FileList registerFileReader: self! ! !Form class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 16:32'! fileReaderServicesForSuffix: suffix ^(suffix = 'bmp') | (suffix = 'gif') | (suffix = 'jpg') | (suffix = 'form') | (suffix = '*') | (suffix = 'png') ifTrue: [ {SimpleServiceEntry provider: self label: 'open image in a window' selector: #openImageInWindow:. SimpleServiceEntry provider: self label: 'read image into ImageImports' selector: #importImage:. SimpleServiceEntry provider: self label: 'open image as background' selector: #openAsBackground:.}] ifFalse: [#()] ! ! !Form class methodsFor: 'fileIn/Out' stamp: 'LEG 10/24/2001 23:42'! importImage: fullName "Import the given image file and store the resulting Form in the global dictionary ImageImports, at a key consisting of the short filename up to the first period. " | key image | key _ fullName sansPeriodSuffix. image _ Form fromFileNamed: fullName. Smalltalk imageImports at: key put: image.! ! !Form class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 16:26'! openAsBackground: fullName "Set an image as a background image. Support Squeak's common file format (GIF, JPG, PNG, 'Form stoteOn: (run coded)' and BMP)" (self fromFileNamed: fullName) setAsBackground! ! !Form class methodsFor: 'fileIn/Out' stamp: 'LEG 10/24/2001 23:59'! openImageInWindow: fullName "Handle five file formats: GIF, JPG, PNG, Form stoteOn: (run coded), and BMP. Fail if file format is not recognized." | image myStream | myStream _ (FileStream readOnlyFileNamed: fullName) binary. image _ self fromBinaryStream: myStream. myStream close. Smalltalk isMorphic ifTrue:[ Project current resourceManager addResource: image url: fullName asUrl asString. ]. Smalltalk isMorphic ifTrue: [(SketchMorph withForm: image) openInWorld] ifFalse: [FormView open: image named: fullName]! ! !Form class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:21'! unload FileList unregisterFileReader: self ! ! !GZipReadStream class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:21'! unload FileList unregisterFileReader: self ! ! !GZipReadStream class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 16:14'! fileReaderServicesForSuffix: suffix ^(suffix = 'gz') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'view decompressed' selector: #viewContents:. SimpleServiceEntry provider: self label: 'decompress to file' selector: #saveContents:}] ifFalse: [#()] ! ! !GZipReadStream class methodsFor: 'fileIn/Out' stamp: 'LEG 10/24/2001 23:56'! saveContents: fullFileName "Save the contents of a gzipped file" | zipped buffer unzipped newName | newName _ fullFileName copyUpToLast: FileDirectory extensionDelimiter. unzipped _ FileStream newFileNamed: newName. unzipped binary. zipped _ GZipReadStream on: (FileStream readOnlyFileNamed: fullFileName). buffer _ ByteArray new: 50000. 'Extracting ' , fullFileName displayProgressAt: Sensor cursorPoint from: 0 to: zipped sourceStream size during: [:bar | [zipped atEnd] whileFalse: [bar value: zipped sourceStream position. unzipped nextPutAll: (zipped nextInto: buffer)]. zipped close. unzipped close]. ^ newName! ! !GZipReadStream class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 17:45'! uncompressedFileName: fullName ^((fullName endsWith: '.gz') and: [self confirm: fullName , ' appears to be a compressed file. Do you want to uncompress it?']) ifFalse: [fullName] ifTrue:[self saveContents: fullName]! ! !GZipReadStream class methodsFor: 'fileIn/Out' stamp: 'LEG 10/24/2001 23:55'! viewContents: fullFileName | f contents | f _ (FileStream readOnlyFileNamed: fullFileName). f binary. contents _ f contentsOfEntireFile. Cursor wait showWhile:[contents _ (GZipReadStream on: contents) upToEnd]. contents _ contents asString withSqueakLineEndings. (StringHolder new) contents: contents; openLabel:'Contents of ', fullFileName! ! !Morph methodsFor: 'menus' stamp: 'hg 8/3/2000 14:57'! doMenuItem: menuString | aMenu anItem aNominalEvent aHand | aMenu _ (aHand _ self currentHand) buildMorphHandleMenuFor: self. aMenu allMorphsDo: [:m | m step]. "Get wordings current" anItem _ aMenu itemWithWording: menuString. anItem ifNil: [^ self player scriptingError: 'Menu item not found: ', menuString]. aHand setArgument: self. aNominalEvent _ MorphicEvent new setMousePoint: 0@0 buttons: Sensor primMouseButtons lastEvent: aHand lastEvent hand: aHand. anItem invokeWithEvent: aNominalEvent defaultTarget: self! ! !MenuItemMorph methodsFor: 'events' stamp: 'di 2/23/98 16:22'! mouseMove: evt | m | m _ evt hand recipientForMouseDown: evt hand lastEvent. m == self ifTrue: [isSelected ifFalse: [m selectFromHand: evt hand]] ifFalse: [self deselectForNewMorph: m. ((m isKindOf: MenuItemMorph) and: [m isInMenu]) ifTrue: [m selectFromHand: evt hand]].! ! !MenuItemMorph methodsFor: 'private' stamp: 'hg 8/3/2000 15:21'! deselectItem | item | self isSelected: false. subMenu ifNotNil: [subMenu deleteIfPopUp]. (owner isKindOf: MenuMorph) ifTrue: [item _ owner popUpOwner. (item isKindOf: MenuItemMorph) ifTrue: [item deselectItem]]. ! ! !MenuMorph methodsFor: 'accessing' stamp: 'hg 8/3/2000 15:29'! items ^ submorphs select: [:m | m isKindOf: MenuItemMorph] ! ! !MenuMorph methodsFor: 'construction' stamp: 'hg 8/3/2000 15:22'! add: aString subMenu: aMenuMorph "Append the given submenu with the given label." | item | item _ MenuItemMorph new. item contents: aString; subMenu: aMenuMorph. self addMorphBack: item. ! ! !MenuMorph methodsFor: 'construction' stamp: 'hg 8/3/2000 15:22'! add: aString target: target selector: aSymbol argumentList: argList "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument." | item | item _ MenuItemMorph new contents: aString; target: target; selector: aSymbol; arguments: argList asArray. self addMorphBack: item. ! ! !MenuMorph methodsFor: 'construction' stamp: 'hg 8/3/2000 15:38'! addService: aService for: serviceUser "Append a menu item with the given service. If the item is selected, it will perform the given service." self add: aService label target: aService selector: aService requestSelector argument: serviceUser ! ! !MenuMorph methodsFor: 'construction' stamp: 'hg 8/3/2000 15:37'! addServices: services for: served extraLines: linesArray services withIndexDo: [:service :i | self addService: service for: served. (linesArray includes: i) | service useLineAfter ifTrue: [self addLine]]. ! ! !MenuMorph methodsFor: 'control' stamp: 'hg 8/3/2000 15:28'! deleteIfPopUp "Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu." stayUp ifFalse: [self topRendererOrSelf delete]. (popUpOwner notNil and: [popUpOwner isKindOf: MenuItemMorph]) ifTrue: [ popUpOwner isSelected: false. (popUpOwner owner isKindOf: MenuMorph) ifTrue: [popUpOwner owner deleteIfPopUp]]. ! ! !MenuMorph methodsFor: 'menu' stamp: 'hg 8/3/2000 15:29'! detachSubMenu: evt | possibleTargets item subMenu | possibleTargets _ evt hand argumentOrNil morphsAt: evt hand targetOffset. item _ possibleTargets detect: [:each | each isKindOf: MenuItemMorph] ifNone: [^ self]. subMenu _ item subMenu. subMenu ifNotNil: [ item subMenu: nil. item delete. subMenu stayUp: true. subMenu popUpOwner: nil. subMenu addTitle: item contents. evt hand attachMorph: subMenu]. ! ! !Morph class methodsFor: 'class initialization' stamp: 'hg 8/3/2000 16:43'! initialize "Morph initialize" "this empty array object is shared by all morphs with no submorphs:" EmptyArray _ Array new. FileList registerFileReader: self! ! !Morph class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:22'! unload FileList unregisterFileReader: self ! ! !Morph class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 16:53'! fileReaderServicesForSuffix: suffix ^(suffix = 'morph') | (suffix = 'morphs') | (suffix = 'sp') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'load as morph' selector: #fromFileName:}] ifFalse: [#()]! ! !Morph class methodsFor: 'fileIn/Out' stamp: 'LEG 10/24/2001 23:52'! fromFileName: fullName "Reconstitute a Morph from the file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world" | aFileStream morphOrList | aFileStream _ FileStream oldFileNamed: fullName. morphOrList _ aFileStream fileInObjectAndCode. (morphOrList isKindOf: SqueakPage) ifTrue: [morphOrList _ morphOrList contentsMorph]. Smalltalk isMorphic ifTrue: [ActiveWorld addMorphsAndModel: morphOrList] ifFalse: [morphOrList isMorph ifFalse: [self inform: 'Can only load a single morph into an mvc project via this mechanism.']. morphOrList openInWorld]! ! !BookMorph class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 17:36'! fileReaderServicesForSuffix: suffix ^(suffix = 'bo') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'load as book' selector: #openFromFile:}] ifFalse: [#()] ! ! !BookMorph class methodsFor: 'fileIn/Out' stamp: 'LEG 10/25/2001 00:06'! openFromFile: fullName "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world" | book aFileStream | Smalltalk verifyMorphicAvailability ifFalse: [^ self]. aFileStream _ FileStream oldFileNamed: fullName. book _ BookMorph new. book setProperty: #url toValue: aFileStream url. book fromRemoteStream: aFileStream. aFileStream close. Smalltalk isMorphic ifTrue: [ActiveWorld addMorphsAndModel: book] ifFalse: [book isMorph ifFalse: [^self inform: 'Can only load a single morph into an mvc project via this mechanism.']. book openInWorld]. book goToPage: 1! ! !BookMorph class methodsFor: 'class initialization' stamp: 'hg 8/3/2000 17:37'! initialize FileList registerFileReader: self! ! !BookMorph class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:20'! unload FileList unregisterFileReader: self ! ! !EventRecorderMorph class methodsFor: 'instance creation' stamp: 'hg 8/3/2000 17:25'! fileReaderServicesForSuffix: suffix ^(suffix = 'tape') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'open for playback' selector: #openTapeFromFile:.}] ifFalse: [#()] ! ! !EventRecorderMorph class methodsFor: 'instance creation' stamp: 'hg 8/3/2000 17:24'! openTapeFromFile: fullName "Open an eventRecorder tape for playback." (EventRecorderMorph new readTape: fullName) rewind openInWorld! ! !EventRecorderMorph class methodsFor: 'class initialization' stamp: 'hg 8/3/2000 17:25'! initialize FileList registerFileReader: self! ! !EventRecorderMorph class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:21'! unload FileList unregisterFileReader: self ! ! !MoviePlayerMorph class methodsFor: 'class initialization' stamp: 'hg 8/3/2000 16:59'! initialize FileList registerFileReader: self! ! !MoviePlayerMorph class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:22'! unload FileList unregisterFileReader: self ! ! !MoviePlayerMorph class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 17:00'! fileReaderServicesForSuffix: suffix ^(suffix = 'movie') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'open as movie' selector: #openAsMovie:.}] ifFalse: [#()]! ! !MoviePlayerMorph class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 17:01'! openAsMovie: fullFileName "Open a MoviePlayerMorph on the given file (must be in .movie format)." (self new openFileNamed: fullFileName) openInWorld! ! !PluggableFileList methodsFor: 'file list menu' stamp: 'hg 8/3/2000 18:08'! fileSelectedMenu: aMenu | firstItems secondItems thirdItems n1 n2 n3 services | firstItems _ self itemsForFileEnding: (FileDirectory extensionFor: self fullName) asLowercase. secondItems _ self itemsForAnyFile. thirdItems _ self itemsForNoFile. n1 _ firstItems size. n2 _ n1 + secondItems size. n3 _ n2 + thirdItems size. services _ firstItems, secondItems, thirdItems, (SimpleServiceEntry provider: self label: 'more...' selector: #offerAllFileOptions). ^ aMenu addServices: services for: self fullName extraLines: (Array with: n1 with: n2 with: n3) ! ! !ProjectViewMorph class methodsFor: 'project window creation' stamp: 'hg 8/3/2000 16:57'! fileReaderServicesForSuffix: suffix ^(suffix = 'extseg') | (suffix = 'project') | (suffix = 'pr') | (suffix = 'morph') | (suffix = 'morphs') | (suffix = 'sp') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'load as project' selector: #openFromFile:.}] ifFalse: [#()]! ! !ProjectViewMorph class methodsFor: 'project window creation' stamp: 'LEG 10/25/2001 00:31'! openFromFile: fileName Project canWeLoadAProjectNow ifFalse: [^ self]. ^ProjectLoading openFromDirectory: nil andFileName: fileName! ! !ProjectViewMorph class methodsFor: 'project window creation' stamp: 'SD 11/14/2001 22:18'! openFromFileList: fullName ^self openFromFile: fullName! ! !ProjectViewMorph class methodsFor: 'initialize-release' stamp: 'hg 8/3/2000 16:54'! initialize FileList registerFileReader: self! ! !ProjectViewMorph class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:22'! unload FileList unregisterFileReader: self ! ! !Scamper class methodsFor: 'instance creation' stamp: 'hg 8/6/2000 20:41'! fileReaderServicesForSuffix: suffix ^(suffix = 'htm') | (suffix = 'html') ifTrue: [ {SimpleServiceEntry provider: self label: 'open in web browser' selector: #openFile:.}] ifFalse: [#()]! ! !Scamper class methodsFor: 'instance creation' stamp: 'hg 8/3/2000 17:21'! openFile: fullFileName Scamper openOnUrl: (FileDirectory forFileName: fullFileName) url , (FileDirectory localNameFor: fullFileName) encodeForHTTP ! ! !Scamper class methodsFor: 'instance creation' stamp: 'SD 11/14/2001 22:17'! openFileFromFileList: fullName self openFile: fullName! ! !Scamper class methodsFor: 'initialization' stamp: 'LEG 10/24/2001 22:54'! initialize self StartUrl: 'browser:about'. FileList registerFileReader: self! ! !Scamper class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:22'! unload FileList unregisterFileReader: self ! ! !ScorePlayerMorph class methodsFor: 'class initialization' stamp: 'hg 8/3/2000 17:28'! fileReaderServicesForSuffix: suffix ^(suffix = 'mid') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'play midi file' selector: #playMidiFile:}] ifFalse: [#()] ! ! !ScorePlayerMorph class methodsFor: 'class initialization' stamp: 'hg 8/3/2000 17:27'! initialize FileList registerFileReader: self! ! !ScorePlayerMorph class methodsFor: 'class initialization' stamp: 'hg 8/3/2000 17:31'! playMidiFile: fullName "Play a MIDI file." | f score | Smalltalk at: #MIDIFileReader ifPresent: [:midiReader | f _ (FileStream oldFileNamed: fullName) binary. score _ (midiReader new readMIDIFrom: f) asScore. f close. self openOn: score title: (FileDirectory localNameFor: fullName)] ! ! !ScorePlayerMorph class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:22'! unload FileList unregisterFileReader: self ! ! !SimpleServiceEntry methodsFor: 'accessing' stamp: 'hg 8/3/2000 13:06'! label ^label! ! !SimpleServiceEntry methodsFor: 'accessing' stamp: 'hg 8/1/2000 18:58'! provider: anObject label: aString selector: aSymbol "basic initialization message" provider _ anObject. label _ aString. selector _ aSymbol! ! !SimpleServiceEntry methodsFor: 'performing service' stamp: 'hg 8/3/2000 13:45'! performServiceFor: anObject "carry out the service I provide" ^selector numArgs = 0 ifTrue: [provider perform: selector] ifFalse: [provider perform: selector with: anObject]! ! !SimpleServiceEntry methodsFor: 'performing service' stamp: 'hg 8/1/2000 19:49'! requestSelector "send me this message to ask me to perform my service" ^#performServiceFor: ! ! !SimpleServiceEntry methodsFor: 'services menu' stamp: 'hg 8/1/2000 19:53'! useLineAfter ^useLineAfter == true! ! !SimpleServiceEntry methodsFor: 'services menu' stamp: 'hg 8/1/2000 19:54'! useLineAfter: aBoolean useLineAfter _ aBoolean ! ! !SimpleServiceEntry class methodsFor: 'instance creation' stamp: 'hg 8/1/2000 18:57'! provider: anObject label: aString selector: aSymbol ^self new provider: anObject label: aString selector: aSymbol! ! !SwikiPage class methodsFor: 'initialization' stamp: 'hg 8/3/2000 17:22'! initialize "SwikiPage initialize" OutputFormat _ OrderedCollection new. OutputFormat add: [:thePage | 'name: ', thePage name printString, '; ']; add: [:thePage | 'date: ', thePage date mmddyyyy printString, '; ']; add: [:thePage | 'time: ''', thePage time asString, '''; ']; add: [:thePage | 'by: ', thePage by printString, '; ']; add: [:thePage | 'pageStatus: #', thePage pageStatus, '; ']"; add: [:thePage | 'text: '].". FileList registerFileReader: self! ! !SwikiPage class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 17:19'! fileReaderServicesForSuffix: suffix ^(suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'generate HTML' selector: #renderFile:.}] ifFalse: [#()] ! ! !SwikiPage class methodsFor: 'fileIn/Out' stamp: 'LEG 10/24/2001 23:46'! renderFile: fullName "Render the given file" | map action file renderedFile formatPage directory | directory _ FileDirectory forFileName: fullName. map _ URLmap new. action _ RenderedSwikiAction new. action name: '.'. "For image references, refer to this directory" map action: action. map directory: directory. (directory fileExists: 'glossary') ifFalse: [Cursor wait showWhile: [ (directory newFileNamed: 'glossary') close].]. map readGlossary: (directory oldFileNamed: 'glossary'). formatPage _ self new. formatPage map: map. formatPage coreID: (fullName allButFirst). formatPage formatted: (HTMLformatter evalEmbedded: (directory oldFileNamed: fullName) contentsOfEntireFile with: formatPage unlessContains: (Set new)). formatPage name isNil ifTrue: [self notifyWithLabel: 'You forgot to name the page!! '. formatPage name: 'defaultName'.]. map pages at: (formatPage name asLowercase) put: formatPage. formatPage formatted: (LessHTMLformatter swikify: (formatPage formatted) linkhandler: [:link | map linkFor: link from: 'Nowhere' storingTo: OrderedCollection new]). "Make a template if one does not exist" (directory fileExists: 'template.html') ifFalse: [Cursor wait showWhile: [ (directory newFileNamed: 'template.html') nextPutAll: (self templateFile); close].]. renderedFile _ (directory pathName),(ServerAction pathSeparator),(formatPage coreID). (directory fileExists: renderedFile) ifTrue: [directory deleteFileNamed: renderedFile]. file _ FileStream fileNamed: renderedFile. file nextPutAll: (HTMLformatter evalEmbedded: (directory oldFileNamed: 'template.html') contentsOfEntireFile with: formatPage). file close. FileDirectory default setMacFileNamed: renderedFile type: 'TEXT' creator: 'MOSS'. map writeGlossary. "Directory is already in the map, so write to the glossary there" ! ! !SwikiPage class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:22'! unload FileList unregisterFileReader: self ! ! !SystemDictionary methodsFor: 'shrinking' stamp: 'LEG 10/24/2001 22:58'! majorShrink "Undertake a major shrinkage of the image. This method throws out lots of the system that is not needed for, eg, operation in a hand-held PC. majorShrink produces a 999k image in Squeak 2.8 Smalltalk majorShrink; abandonSources; lastRemoval" | oldDicts newDicts | Smalltalk isMorphic ifTrue: [^ self error: 'You can only run majorShrink in MVC']. Project current isTopProject ifFalse: [^ self error: 'You can only run majorShrink in the top project']. (Smalltalk confirm: 'All sub-projects will be deleted from this image. You should already have made a backup copy, or you must save with a different name after shrinking. Shall we proceed to discard most of the content in this image?') ifFalse: [^ self inform: 'No changes have been made.']. "Remove all projects but the current one. - saves 522k" ProjectView allInstancesDo: [:pv | pv controller closeAndUnscheduleNoTerminate]. Project current setParent: Project current. MorphWorldView allInstancesDo: [:pv | pv topView controller closeAndUnscheduleNoTerminate]. Smalltalk at: #Wonderland ifPresent:[:cls| cls removeActorPrototypesFromSystem]. Player freeUnreferencedSubclasses. MorphicModel removeUninstantiatedModels. Utilities classPool at: #ScrapsBook put: nil. Utilities zapUpdateDownloader. ProjectHistory currentHistory initialize. Project rebuildAllProjects. Smalltalk discardVMConstruction. "755k" Smalltalk discardSoundSynthesis. "544k" Smalltalk discardOddsAndEnds. "227k" Smalltalk discardNetworking. "234k" Smalltalk discard3D. "407k" Smalltalk discardFFI. "33k" Smalltalk discardMorphic. "1372k" Symbol rehash. "40k" "Above by itself saves about 4,238k" "Remove references to a few classes to be deleted, so that they won't leave obsolete versions around." ChangeSet class compile: 'defaultName ^ ''Changes'' ' classified: 'initialization'. ScreenController removeSelector: #openChangeManager. ScreenController removeSelector: #exitProject. ScreenController removeSelector: #openProject. ScreenController removeSelector: #viewImageImports. "Now delete various other classes.." SystemOrganization removeSystemCategory: 'Graphics-Files'. SystemOrganization removeSystemCategory: 'System-Object Storage'. Smalltalk removeClassNamed: #ProjectController. Smalltalk removeClassNamed: #ProjectView. "Smalltalk removeClassNamed: #Project." Smalltalk removeClassNamed: #Environment. Smalltalk removeClassNamed: #Component1. Smalltalk removeClassNamed: #FormSetFont. Smalltalk removeClassNamed: #FontSet. Smalltalk removeClassNamed: #InstructionPrinter. Smalltalk removeClassNamed: #ChangeSorter. Smalltalk removeClassNamed: #DualChangeSorter. Smalltalk removeClassNamed: #EmphasizedMenu. Smalltalk removeClassNamed: #MessageTally. StringHolder class removeSelector: #originalWorkspaceContents. CompiledMethod removeSelector: #symbolic. RemoteString removeSelector: #makeNewTextAttVersion. Utilities class removeSelector: #absorbUpdatesFromServer. Smalltalk removeClassNamed: #PenPointRecorder. Smalltalk removeClassNamed: #Path. Smalltalk removeClassNamed: #Base64MimeConverter. "Smalltalk removeClassNamed: #EToySystem. Dont bother - its very small and used for timestamps etc" Smalltalk removeClassNamed: #RWBinaryOrTextStream. Smalltalk removeClassNamed: #AttributedTextStream. Smalltalk removeClassNamed: #WordNet. Smalltalk removeClassNamed: #SelectorBrowser. TextStyle allSubInstancesDo: [:ts | ts newFontArray: (ts fontArray copyFrom: 1 to: (2 min: ts fontArray size))]. ListParagraph initialize. PopUpMenu initialize. StandardSystemView initialize. Smalltalk noChanges. ChangeSorter classPool at: #AllChangeSets put: (OrderedCollection with: Smalltalk changes). SystemDictionary removeSelector: #majorShrink. [Smalltalk removeAllUnSentMessages > 0] whileTrue: [Smalltalk unusedClasses do: [:c | (Smalltalk at: c) removeFromSystem]]. SystemOrganization removeEmptyCategories. Smalltalk allClassesDo: [:c | c zapOrganization]. Smalltalk garbageCollect. 'Rehashing method dictionaries . . .' displayProgressAt: Sensor cursorPoint from: 0 to: MethodDictionary instanceCount during: [:bar | oldDicts _ MethodDictionary allInstances. newDicts _ Array new: oldDicts size. oldDicts withIndexDo: [:d :index | bar value: index. newDicts at: index put: d rehashWithoutBecome. ]. oldDicts elementsExchangeIdentityWith: newDicts. ]. oldDicts _ newDicts _ nil. Project rebuildAllProjects. Smalltalk changes initialize. "seems to take more than one try to gc all the weak refs in SymbolTable" 3 timesRepeat: [ Smalltalk garbageCollect. Symbol compactSymbolTable. ]. ! ! !Wonderland class methodsFor: 'class initialization' stamp: 'hg 8/3/2000 16:23'! initialize "Initialize the WonderlandClass by creating the ActorPrototypeClasses collection" ActorPrototypeClasses _ Dictionary new. FileList registerFileReader: self! ! !Wonderland class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:22'! unload FileList unregisterFileReader: self ! ! !Wonderland class methodsFor: 'fileIn/Out' stamp: 'SD 11/11/2001 14:16'! fileReaderServicesForSuffix: suffix ^(suffix = 'wrl') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'open in Wonderland' selector: #openVRMLFile:}] ifFalse: [(suffix = 'mdl') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'open model in editor' selector: #openModelIntoAlice:}] ifFalse: [#()]] ! ! !Wonderland class methodsFor: 'fileIn/Out' stamp: 'SD 11/11/2001 14:16'! openModelIntoAlice: fullName "If a Wonderland exists, load this model into it as an actor. If it doesn't, make one first" | alice | Smalltalk isMorphic ifFalse: [^self error: 'Only works in Morphic - sorry!!']. alice _ World submorphs detect: [:m | m isKindOf: WonderlandEditor] ifNone: [nil]. alice isNil ifTrue: [alice := Wonderland new] ifFalse: [alice := alice getWonderland]. alice makeActorFrom: fullName. ! ! !Wonderland class methodsFor: 'fileIn/Out' stamp: 'hg 8/3/2000 16:21'! openVRMLFile: fullName Wonderland new makeActorFromVRML: fullName. ! ! !ZipArchive class methodsFor: 'class variables' stamp: 'hg 12/12/2001 12:22'! initialize "ZipArchive initialize" [self initializeZipFileConstants] on: Warning do: [:ex | ex resume: true]. FileList registerFileReader: self! ! !ZipArchive class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:08'! addFileToZip: fullName "Add the currently selected file to a new zip" | zip | zip := (ZipArchive new) addFile: fullName as: (FileDirectory localNameFor: fullName); yourself. (ArchiveViewer open) archive: zip! ! !ZipArchive class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:00'! fileReaderServicesForSuffix: suffix ^(suffix = 'gz') | (suffix = 'gzip') | (suffix = '*') ifTrue: [ {SimpleServiceEntry provider: self label: 'add file to zip' selector: #addFileToZip:}] ifFalse: [#()] ! ! !ZipArchive class methodsFor: 'class initialization' stamp: 'SD 11/15/2001 22:22'! unload FileList unregisterFileReader: self ! ! ZipArchive initialize! Wonderland initialize! SwikiPage initialize! !SimpleServiceEntry reorganize! ('accessing' label provider:label:selector:) ('performing service' performServiceFor: requestSelector) ('services menu' useLineAfter useLineAfter:) ! ScorePlayerMorph initialize! !ScorePlayerMorph class reorganize! ('system hookup' descriptionForPartsBin onMIDIFileNamed: openOn:title:) ('class initialization' fileReaderServicesForSuffix: initialize playMidiFile: unload) ! Scamper initialize! ProjectViewMorph initialize! MoviePlayerMorph initialize! EventRecorderMorph initialize! BookMorph initialize! Morph initialize! Form initialize! FlashMorphReader initialize! !FlashMorphReader class reorganize! ('class initialization' initialize unload) ('read Flash file' fileReaderServicesForSuffix: openAsFlash:) ! FileStream initialize! FileList2 class removeSelector: #morphicViewImageViewer! FileList initialize! !FileList class reorganize! ('instance creation' addButtonsAndFileListPanesTo:at:plus:forFileList: addVolumesAndPatternPanesTo:at:plus:forFileList: defaultButtonPaneHeight open openAsMorph openEditorOn:editString: openFileDirectly openMorphOn:editString: prototypicalToolWindow) ('class initialization' initialize) ('file reader registration' isReaderNamedRegistered: registerFileReader: registeredFileReaderClasses unregisterFileReader:) ! FileList removeSelector: #browseFile! FileList removeSelector: #errorMustBeMorph! FileList removeSelector: #fileAllIn! FileList removeSelector: #fileInSelection! FileList removeSelector: #fileIntoNewChangeSet! FileList removeSelector: #fileNameSuffix! FileList removeSelector: #getSuffix:! FileList removeSelector: #importImage! FileList removeSelector: #open3DSFile! FileList removeSelector: #openAsBackground! FileList removeSelector: #openAsFlash! FileList removeSelector: #openAsMovie! FileList removeSelector: #openAsTTF! FileList removeSelector: #openBookFromFile! FileList removeSelector: #openImageInWindow! FileList removeSelector: #openInBrowser! FileList removeSelector: #openMorphFromFile! FileList removeSelector: #openProjectFromFile! FileList removeSelector: #openTapeFromFile! FileList removeSelector: #openVRMLFile! FileList removeSelector: #playMidiFile! FileList removeSelector: #putUpdate! FileList removeSelector: #removeLinefeeds! FileList removeSelector: #renderFile! FileList removeSelector: #saveGZipContents! FileList removeSelector: #uncompressedFileName! FileList removeSelector: #viewGZipContents! !FileList reorganize! ('initialization' directory: labelString modelSleep modelWakeUp optionalButtonHeight optionalButtonRow optionalButtonSpecs optionalButtonView release setFileStream:) ('volume list and pattern' deleteDirectory directory fileNameFormattedFrom:sizePad: listForPattern: pattern pattern: veryDeepFixupWith: volumeList volumeListIndex volumeListIndex:) ('file list' fileList fileListIndex fileListIndex:) ('apparently not called' openArchiveViewer) ('file menu action' addNew:byEvaluating: addNewDirectory addNewFile compressFile deleteFile editFile get getHex renameFile sortByDate sortByName sortBySize spawn: templateFile) ('obsolete methods' addFileToZip browseFiles loadCRDictionary loadCRDisplayProperties openModelintoAlice) ('to be transformed in registration' askServerInfo fileContentsMenu:shifted: fullFileListMenu:shifted: perform:orSendTo: putUpdate: removeServer volumeMenu:) ('file list menu' fileListMenu: fileSelectedMenu: itemsForAnyFile itemsForFileEnding: itemsForNoFile myServicesForFileEnding: noFileSelectedMenu: offerAllFileOptions) ('private' addPath: contents defaultContents entriesMatching: fileNameFromFormattedItem: folderString fullName isFileSelected put: readContentsBrief: readContentsHex: readServerBrief recentDirs registeredFileReaderClasses resort: sortBlock sortingByDate sortingByName sortingBySize updateFileList) ('menu messages' browseChanges copyName) ('drag and drop') ! FileContentsBrowser initialize! DummyToolWorkingWithFileList initialize! ChangeSorter initialize! ChangeList initialize! CRRecognizer initialize! B3DScene initialize!