'From Squeak3.1alpha of 4 February 2001 [latest update: #3710] on 24 February 2001 at 5:01:45 pm'! "Change Set: ZipViewer-nk Date: 24 February 2001 Author: Ned Konz This is a moderately full-featured graphical Zip file explorer. It only works in Morphic. It requires my Archive-Zip change set. It looks best if you have a fixed text font like Atlanta 11."! SystemWindow subclass: #ArchiveViewer instanceVariableNames: 'archive fileName memberIndex ' classVariableNames: '' poolDictionaries: '' category: 'Tools-ArchiveViewer'! !Archive methodsFor: 'archive operations' stamp: 'nk 2/24/2001 14:12'! canWriteToFileNamed: aFileName "Catch attempts to overwrite existing zip file" ^(members anySatisfy: [ :ea | ea usesFileNamed: aFileName ]) not. ! ! !Archive methodsFor: 'archive operations' stamp: 'nk 2/24/2001 14:15'! writeToFileNamed: aFileName | stream | "Catch attempts to overwrite existing zip file" (self canWriteToFileNamed: aFileName) ifFalse: [ ^self error: (aFileName, ' is needed by one or more members in this archive') ]. stream _ StandardFileStream forceNewFileNamed: aFileName. self writeTo: stream. stream close.! ! !ArchiveViewer methodsFor: 'member operations' stamp: 'nk 2/24/2001 16:13'! addMember | result relative | self canAddMember ifFalse: [ ^self ]. result _ StandardFileMenu oldFile. result ifNil: [ ^self ]. relative _ result directory fullNameFor: result name. (relative beginsWith: FileDirectory default pathName) ifTrue: [ relative _ relative copyFrom: FileDirectory default pathName size + 2 to: relative size ]. (archive addFile: relative) desiredCompressionMethod: ZipArchive compressionDeflated. memberIndex _ self members size. self changed: #memberList.! ! !ArchiveViewer methodsFor: 'member operations' stamp: 'nk 2/24/2001 15:55'! addMemberFromClipboard | string newName | self canAddMember ifFalse: [ ^self ]. string _ Clipboard clipboardText asString. newName _ FillInTheBlankMorph request: 'New name for member:' initialAnswer: 'clipboardText'. newName notEmpty ifTrue: [ (archive addString: string as: newName) desiredCompressionMethod: ZipArchive compressionDeflated. memberIndex _ self members size. self changed: #memberList. ] ! ! !ArchiveViewer methodsFor: 'member operations' stamp: 'nk 2/24/2001 14:50'! canAddMember ^archive notNil! ! !ArchiveViewer methodsFor: 'member operations' stamp: 'nk 2/24/2001 11:02'! canDeleteMember ^memberIndex > 0! ! !ArchiveViewer methodsFor: 'member operations' stamp: 'nk 2/24/2001 11:02'! canExtractMember ^memberIndex > 0! ! !ArchiveViewer methodsFor: 'member operations' stamp: 'nk 2/24/2001 11:02'! canRenameMember ^memberIndex > 0! ! !ArchiveViewer methodsFor: 'member operations' stamp: 'nk 2/24/2001 13:50'! commentMember | newName | newName _ FillInTheBlankMorph request: 'New comment for member:' initialAnswer: self selectedMember fileComment centerAt: Sensor cursorPoint inWorld: self world onCancelReturn: self selectedMember fileComment acceptOnCR: true. self selectedMember fileComment: newName.! ! !ArchiveViewer methodsFor: 'member operations' stamp: 'nk 2/24/2001 14:53'! deleteMember self canDeleteMember ifFalse: [ ^self ]. archive removeMember: self selectedMember. memberIndex _ 0. self changed: #memberList. ! ! !ArchiveViewer methodsFor: 'member operations' stamp: 'nk 2/24/2001 14:53'! extractMember | result name | self canExtractMember ifFalse: [ ^self ]. result _ StandardFileMenu newFile. result ifNil: [ ^self ]. name _ (result directory fullNameFor: result name). (archive canWriteToFileNamed: name) ifFalse: [ self inform: name, ' is used by one or more members in your archive, and cannot be overwritten. Try extracting to another file name'. ^self ]. self selectedMember extractToFileNamed: name.! ! !ArchiveViewer methodsFor: 'member operations' stamp: 'nk 2/24/2001 13:01'! inspectMember self selectedMember inspect! ! !ArchiveViewer methodsFor: 'member operations' stamp: 'nk 2/24/2001 14:53'! renameMember | newName | self canRenameMember ifFalse: [ ^self ]. newName _ FillInTheBlankMorph request: 'New name for member:' initialAnswer: self selectedMember fileName. newName notEmpty ifTrue: [ self selectedMember fileName: newName. self changed: #memberList ]! ! !ArchiveViewer methodsFor: 'member list' stamp: 'nk 2/24/2001 14:42'! displayLineFor: aMember | stream dateTime | stream _ WriteStream on: (String new: 60). dateTime _ Time dateAndTimeFromSeconds: aMember lastModTime. stream nextPutAll: (aMember uncompressedSize printString padded: #left to: 7 with: $ ); nextPutAll: (aMember compressedSize printString padded: #left to: 7 with: $ ); space; space; nextPutAll: (aMember crc32String ); space; space. dateTime first printOn: stream format: #(3 2 1 $- 2 1 2). stream space. dateTime second print24: true showSeconds: false on: stream. stream space; space; nextPutAll: (aMember fileName ). ^stream contents! ! !ArchiveViewer methodsFor: 'member list' stamp: 'nk 2/23/2001 22:48'! highlightMemberList: list with: morphList (morphList at: self memberIndex) color: Color red! ! !ArchiveViewer methodsFor: 'member list' stamp: 'nk 2/24/2001 09:40'! memberIndex ^memberIndex! ! !ArchiveViewer methodsFor: 'member list' stamp: 'nk 2/23/2001 22:42'! memberIndex: n memberIndex _ n. self changed: #memberIndex! ! !ArchiveViewer methodsFor: 'member list' stamp: 'nk 2/24/2001 11:51'! memberList ^ self members collect: [ :ea | self displayLineFor: ea ]! ! !ArchiveViewer methodsFor: 'member list' stamp: 'nk 2/24/2001 13:42'! memberMenu: menu shifted: shifted ^ menu add: 'Inspect member' target: self selector: #inspectMember; balloonTextForLastItem: 'Inspect the selected member'; add: 'Comment member' target: self selector: #commentMember; balloonTextForLastItem: 'Add a comment for the selected member'; add: 'Comment archive' target: self selector: #commentArchive; balloonTextForLastItem: 'Add a comment for the entire archive'; yourself! ! !ArchiveViewer methodsFor: 'archive operations' stamp: 'nk 2/24/2001 13:54'! canCreateNewArchive ^true! ! !ArchiveViewer methodsFor: 'archive operations' stamp: 'nk 2/24/2001 14:56'! canExtractAll ^self members size > 0! ! !ArchiveViewer methodsFor: 'archive operations' stamp: 'nk 2/24/2001 11:12'! canOpenNewArchive ^true! ! !ArchiveViewer methodsFor: 'archive operations' stamp: 'nk 2/24/2001 13:55'! canSaveArchive ^archive notNil! ! !ArchiveViewer methodsFor: 'archive operations' stamp: 'nk 2/24/2001 13:49'! commentArchive | newName | archive ifNil: [ ^self ]. newName _ FillInTheBlankMorph request: 'New comment for archive:' initialAnswer: archive zipFileComment centerAt: Sensor cursorPoint inWorld: self world onCancelReturn: archive zipFileComment acceptOnCR: true. archive zipFileComment: newName.! ! !ArchiveViewer methodsFor: 'archive operations' stamp: 'nk 2/24/2001 13:34'! createNewArchive self setLabel: '(new archive)'. archive _ ZipArchive new. memberIndex _ 0. self changed: #memberList.! ! !ArchiveViewer methodsFor: 'archive operations' stamp: 'nk 2/24/2001 15:43'! extractAll | directory | self canExtractAll ifFalse: [^ self]. [| safe | directory _ FileList2 modalFolderSelector. directory ifNil: [^ self]. safe _ self extractAllPossibleInDirectory: directory. safe ifTrue: ["extract all" self members do: [:ea | ea isDirectory ifTrue: [[directory createDirectory: ea fileName allButLast] on: Error do: [:ex | (PopUpMenu confirm: ea fileName , ' cannot be created. Continue?') ifFalse: [^ self]]] ifFalse: [| stream | stream _ directory forceNewFileNamed: ea fileName. stream ifNil: [(PopUpMenu confirm: ea fileName , ' cannot be created. Continue?') ifFalse: [^ self]] ifNotNil: [ea extractTo: stream]]]. ^ self] ifFalse: [PopUpMenu confirm: 'Try again?']] whileTrue! ! !ArchiveViewer methodsFor: 'archive operations' stamp: 'nk 2/24/2001 15:27'! extractAllPossibleInDirectory: directory "Answer true if I can extract all the files in the given directory safely. Inform the user as to problems." | conflicts | self canExtractAll ifFalse: [ ^false ]. conflicts _ Set new. self members do: [ :ea | | fullName | fullName _ directory fullNameFor: ea fileName. (ea usesFileNamed: fullName) ifTrue: [ conflicts add: fullName ]. ]. conflicts notEmpty ifTrue: [ | str | str _ WriteStream on: (String new: 200). str nextPutAll: 'The following file(s) are needed by archive members and cannot be overwritten:'; cr. conflicts do: [ :ea | str nextPutAll: ea ] separatedBy: [ str cr ]. self inform: str contents. ^false. ]. conflicts _ Set new. self members do: [ :ea | | fullName | (directory fileExists: ea fileName) ifTrue: [ conflicts add: (directory fullNameFor: ea fileName) ]. ]. conflicts notEmpty ifTrue: [ | str | str _ WriteStream on: (String new: 200). str nextPutAll: 'The following file(s) will be overwritten:'; cr. conflicts do: [ :ea | str nextPutAll: ea ] separatedBy: [ str cr ]. str cr; nextPutAll: 'Is this OK?'. ^PopUpMenu confirm: str contents. ]. ^true. ! ! !ArchiveViewer methodsFor: 'archive operations' stamp: 'nk 2/24/2001 13:27'! openNewArchive | menu result | menu _ StandardFileMenu oldFileMenu: (FileDirectory default) withPattern: '*.zip'. result := menu startUpWithCaption: 'Select Zip archive to open...'. result ifNil: [ ^self ]. self fileName: (result directory fullNameFor: result name). ! ! !ArchiveViewer methodsFor: 'archive operations' stamp: 'nk 2/24/2001 15:51'! saveArchive | result name | self canSaveArchive ifFalse: [ ^self ]. result _ StandardFileMenu newFile. result ifNil: [ ^self ]. name _ result directory fullNameFor: result name. (archive canWriteToFileNamed: name) ifFalse: [ self inform: name, ' is used by one or more members in your archive, and cannot be overwritten. Try writing to another file name'. ^self ]. [ archive writeToFileNamed: name ] on: Error do: [ :ex | self inform: ex description. ]. self changed: #memberList "in case CRC's and compressed sizes got set"! ! !ArchiveViewer methodsFor: 'initialization' stamp: 'nk 2/24/2001 09:48'! backgroundColor ^Color white! ! !ArchiveViewer methodsFor: 'initialization' stamp: 'nk 2/24/2001 09:48'! buttonColor ^self backgroundColor darker! ! !ArchiveViewer methodsFor: 'initialization' stamp: 'nk 2/24/2001 09:49'! buttonOffColor ^self backgroundColor darker! ! !ArchiveViewer methodsFor: 'initialization' stamp: 'nk 2/24/2001 09:49'! buttonOnColor ^self backgroundColor! ! !ArchiveViewer methodsFor: 'initialization' stamp: 'nk 2/24/2001 15:45'! createButtonBar | bar button | bar _ AlignmentMorph newRow. bar color: self backgroundColor; rubberBandCells: false; cellInset: 6@0. #( #( 'New\Archive' canCreateNewArchive createNewArchive ) #( 'Load\Archive' canOpenNewArchive openNewArchive ) #( 'Save\Archive As' canSaveArchive saveArchive ) #( 'Extract\All' canExtractAll extractAll ) #( 'Add\Member' canAddMember addMember ) #( 'Add Member\from Clipboard' canAddMember addMemberFromClipboard ) #( 'Extract\Member As' canExtractMember extractMember ) #( 'Delete\Member' canDeleteMember deleteMember ) #( 'Rename\Member' canRenameMember renameMember ) ) do: [ :arr | (button _ PluggableButtonMorph on: self getState: arr second action: arr third) vResizing: #spaceFill; hResizing: #spaceFill; onColor: self buttonOnColor offColor: self buttonOffColor; label: (TextMorph new contents: arr first withCRs) lock ; yourself. bar addMorphBack: button. ]. ^bar.! ! !ArchiveViewer methodsFor: 'initialization' stamp: 'nk 2/24/2001 14:44'! createListHeadingUsingFont: font | sm | sm _ StringMorph contents: ' uncomp comp CRC-32 date time file name'. font ifNotNil: [ sm font: font ]. ^(AlignmentMorph newColumn) color: self backgroundColor; addMorph: sm; yourself.! ! !ArchiveViewer methodsFor: 'initialization' stamp: 'nk 2/24/2001 16:22'! createWindow | list heading font | self color: self backgroundColor. font _ (TextStyle named: #DefaultFixedTextStyle) ifNotNilDo: [ :ts | ts fontArray first ]. self addMorph: (self createButtonBar) frame: (0@0 corner: 1.0@0.1). heading _ self createListHeadingUsingFont: font. self addMorph: heading frame: (0@0.1 corner: 1.0@0.14). (list _ PluggableListMorph new) on: self list: #memberList selected: #memberIndex changeSelected: #memberIndex: menu: #memberMenu:shifted: keystroke: nil. list color: self backgroundColor. font ifNotNil: [ list font: font ]. self addMorph: list frame: (0@0.14 corner: 1.0@1.0). self setLabel: 'Ned''s Zip Viewer'! ! !ArchiveViewer methodsFor: 'initialization' stamp: 'nk 2/24/2001 13:21'! fileName: aString archive _ ZipArchive new readFrom: aString. self setLabel: aString. memberIndex _ 0. self changed: #memberList! ! !ArchiveViewer methodsFor: 'initialization' stamp: 'nk 2/24/2001 12:39'! initialize super initialize. memberIndex _ 0.! ! !ArchiveViewer methodsFor: 'panes' stamp: 'nk 2/24/2001 10:09'! paneColorToUse ^self backgroundColor! ! !ArchiveViewer methodsFor: 'accessing' stamp: 'nk 2/24/2001 11:03'! archive ^archive! ! !ArchiveViewer methodsFor: 'accessing' stamp: 'nk 2/24/2001 11:03'! fileName ^fileName! ! !ArchiveViewer methodsFor: 'accessing' stamp: 'nk 2/24/2001 14:56'! members ^archive ifNil: [ #() asOrderedCollection ] ifNotNil: [ archive members asOrderedCollection ]! ! !ArchiveViewer methodsFor: 'accessing' stamp: 'nk 2/24/2001 11:17'! selectedMember ^memberIndex ifNil: [ nil ] ifNotNil: [ self members at: memberIndex ifAbsent: [ ] ]! ! !ArchiveViewer methodsFor: 'message handling' stamp: 'nk 2/24/2001 13:16'! perform: selector orSendTo: otherTarget ^ self perform: selector! ! !ArchiveViewer class methodsFor: 'as yet unclassified' stamp: 'nk 2/23/2001 21:52'! open ^(self new) createWindow; openInWorld.! ! !ArchiveViewer class methodsFor: 'as yet unclassified' stamp: 'nk 2/24/2001 14:20'! openOn: aFileName ^(self new) createWindow; fileName: aFileName; openInWorld.! ! !FileList methodsFor: 'file list menu' stamp: 'ar 2/24/2001 16:44'! itemsForFileEnding: suffix | labels lines selectors | labels _ OrderedCollection new. lines _ OrderedCollection new. selectors _ OrderedCollection new. (suffix = 'bmp') | (suffix = 'gif') | (suffix = 'jpg') | (suffix = 'form') | (suffix = '*') | (suffix = 'png') ifTrue: [labels addAll: #('open image in a window' 'read image into ImageImports' 'open image as background'). selectors addAll: #(openImageInWindow importImage openAsBackground)]. (suffix = 'morph') | (suffix = 'morphs') | (suffix = 'sp') | (suffix = '*') ifTrue: [labels add: 'load as morph'. selectors add: #openMorphFromFile. labels add: 'load as project'. selectors add: #openProjectFromFile]. (suffix = 'extseg') | (suffix = 'project') | (suffix = 'pr') ifTrue: [labels add: 'load as project'. selectors add: #openProjectFromFile]. (suffix = 'bo') | (suffix = '*') ifTrue:[ labels add: 'load as book'. selectors add: #openBookFromFile]. (suffix = 'mid') | (suffix = '*') ifTrue: [labels add: 'play midi file'. selectors add: #playMidiFile]. (suffix = 'movie') | (suffix = '*') ifTrue: [labels add: 'open as movie'. selectors add: #openAsMovie]. (suffix = 'st') | (suffix = 'cs') | (suffix = '*') ifTrue: [suffix = '*' ifTrue: [lines add: labels size]. labels addAll: #('fileIn' 'file into new change set' 'browse changes' 'browse code' 'remove line feeds' 'broadcast as update'). lines add: labels size - 1. selectors addAll: #(fileInSelection fileIntoNewChangeSet browseChanges browseFile removeLinefeeds putUpdate)]. (suffix = 'swf') | (suffix = '*') ifTrue:[ labels add:'open as Flash'. selectors add: #openAsFlash]. (suffix = 'ttf') | (suffix = '*') ifTrue:[ labels add: 'open true type font'. selectors add: #openAsTTF]. (suffix = 'gz') | (suffix = '*') ifTrue:[ labels addAll: #('view decompressed' 'decompress to file'). selectors addAll: #(viewGZipContents saveGZipContents)]. (suffix = '3ds') | (suffix = '*') ifTrue:[ labels add: 'Open 3DS file'. selectors add: #open3DSFile]. (suffix = 'tape') | (suffix = '*') ifTrue: [labels add: 'open for playback'. selectors add: #openTapeFromFile]. (suffix = 'wrl') | (suffix = '*') ifTrue: [labels add: 'open in Wonderland'. selectors add: #openVRMLFile]. (suffix = 'htm') | (suffix = 'html') ifTrue: [labels add: 'open in browser'. selectors add: #openInBrowser]. (suffix = 'zip') | (suffix = '*') ifTrue: [labels add: 'open archive viewer'. selectors add: #openArchiveViewer]. (suffix = '*') ifTrue: [labels addAll: #('generate HTML'). lines add: labels size - 1. selectors addAll: #(renderFile)]. (suffix = CRDictionary fileNameSuffix) ifTrue: [labels add: 'load Genie Gesture Dictionary'. selectors add: #loadCRDictionary]. (suffix = CRDisplayProperties fileNameSuffix) ifTrue: [labels add: 'load Genie Display Properties'. selectors add: #loadCRDisplayProperties]. ^ Array with: labels with: lines with: selectors! ! !FileList methodsFor: 'file list menu' stamp: 'ar 2/24/2001 16:44'! openArchiveViewer ArchiveViewer openOn: self fullName.! ! !ZipArchive methodsFor: 'accessing' stamp: 'nk 2/24/2001 13:44'! zipFileComment ^zipFileComment asString! ! !ZipArchive methodsFor: 'accessing' stamp: 'nk 2/24/2001 13:43'! zipFileComment: aString zipFileComment _ aString! ! !ZipArchiveMember methodsFor: 'accessing' stamp: 'nk 2/24/2001 14:34'! lastModTime "Return my last modification date/time stamp, converted to Squeak seconds" ^self unixToSqueakTime: (self dosToUnixTime: lastModFileDateTime)! ! !ZipArchiveMember methodsFor: 'initialization' stamp: 'nk 2/24/2001 16:16'! initialize super initialize. lastModFileDateTime _ 0. fileAttributeFormat _ FaUnix. versionMadeBy _ 20. versionNeededToExtract _ 20. bitFlag _ 0. compressionMethod _ CompressionStored. desiredCompressionMethod _ CompressionDeflated. desiredCompressionLevel _ CompressionLevelDefault. internalFileAttributes _ 0. externalFileAttributes _ 0. fileName _ ''. cdExtraField _ ''. localExtraField _ ''. fileComment _ ''. crc32 _ 0. compressedSize _ 0. uncompressedSize _ 0. self unixFileAttributes: DefaultFilePermissions.! ! !ZipFileMember methodsFor: 'testing' stamp: 'nk 2/24/2001 14:07'! usesFileNamed: aFileName "Do I require aFileName? That is, do I care if it's clobbered?" ^(FileDirectory default fullNameFor: externalFileName) = (FileDirectory default fullNameFor: aFileName)! ! !ZipNewFileMember methodsFor: 'testing' stamp: 'nk 2/24/2001 15:03'! usesFileNamed: aFileName "Do I require aFileName? That is, do I care if it's clobbered?" ^(FileDirectory default fullNameFor: externalFileName) = (FileDirectory default fullNameFor: aFileName)! ! !ZipArchive reorganize! ('archive operations' readFrom: writeTo:) ('initialization' initialize) ('private' findEndOfCentralDirectoryFrom: memberClass readEndOfCentralDirectoryFrom: readMembersFrom:named: readSignatureFrom: writeCentralDirectoryTo: writeEndOfCentralDirectoryTo:) ('accessing' zipFileComment zipFileComment:) ! !ArchiveViewer reorganize! ('member operations' addMember addMemberFromClipboard canAddMember canDeleteMember canExtractMember canRenameMember commentMember deleteMember extractMember inspectMember renameMember) ('member list' displayLineFor: highlightMemberList:with: memberIndex memberIndex: memberList memberMenu:shifted:) ('archive operations' canCreateNewArchive canExtractAll canOpenNewArchive canSaveArchive commentArchive createNewArchive extractAll extractAllPossibleInDirectory: openNewArchive saveArchive) ('initialization' backgroundColor buttonColor buttonOffColor buttonOnColor createButtonBar createListHeadingUsingFont: createWindow fileName: initialize) ('panes' paneColorToUse) ('accessing' archive fileName members selectedMember) ('message handling' perform:orSendTo:) !