diff -r cd5cb075fd6a -r ccde5a941840 FileBrowser.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/FileBrowser.st Sat Aug 13 20:40:49 1994 +0200 @@ -0,0 +1,1633 @@ +" + COPYRIGHT (c) 1991 by Claus Gittinger + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" + +StandardSystemView subclass:#FileBrowser + instanceVariableNames:'labelView filterField fileListView subView + currentDirectory + queryBox yesNoBox + topFrame fileList + checkBlock checkDelta timeOfLastCheck + showLongList showVeryLongList showDotFiles + myName killButton' + classVariableNames:'DirectoryHistory HistorySize' + poolDictionaries:'' + category:'Interface-Browsers' +! + +FileBrowser comment:' +COPYRIGHT (c) 1991 by Claus Gittinger + All Rights Reserved + +$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.15 1994-08-13 18:40:28 claus Exp $ +'! + +!FileBrowser class methodsFor:'documentation'! + +copyright +" + COPYRIGHT (c) 1991 by Claus Gittinger + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" +! + +version +" +$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.15 1994-08-13 18:40:28 claus Exp $ +" +! + +documentation +" + this used to be a very simple demo application, + but migrated into a quite nice tool, includes all kinds of + warning and information boxes, background processes for directory- + reading and internationalized strings. A good example for beginners, + on how to do things .... + See additional information in 'doc/misc/fbrowser.doc'. +" +! ! + +!FileBrowser class methodsFor:'instance creation'! + +openOn:aDirectoryPath + "start a new FileBrowser in a pathname" + + ^ (self new currentDirectory:aDirectoryPath) open + + "FileBrowser openOn:'aDirectoryPath'" +! ! + +!FileBrowser methodsFor:'initialization'! + +initialize + |frame spacing halfSpacing v| + + super initialize. + + DirectoryHistory isNil ifTrue:[ + DirectoryHistory := OrderedCollection new. + HistorySize := 15. + ]. + + myName := (resources string:self class name). + self label:myName. + self icon:(Form fromFile:(resources at:'ICON_FILE' default:'FBrowser.xbm') + resolution:100). + + spacing := ViewSpacing. + halfSpacing := spacing // 2. + + checkBlock := [self checkIfDirectoryHasChanged]. + checkDelta := 5. + + currentDirectory := FileDirectory directoryNamed:'.'. + showLongList := resources at:'LONG_LIST' default:false. + showDotFiles := resources at:'SHOW_DOT_FILES' default:false. + + filterField := EditField in:self. + filterField origin:[((width // 4 * 3) + halfSpacing) @ halfSpacing] + extent:[((width // 4) - borderWidth + - (filterField margin) + - halfSpacing + - filterField borderWidth) + @ + (filterField heightIncludingBorder "i.e. take its default height" + "font height + font descent + (filterField margin * 2)" + ) + ]. + self initializeFilterPattern. + filterField leaveAction:[:key | fileListView scrollToTop. self updateCurrentDirectory]. + + labelView := Label in:self. + labelView origin:(halfSpacing @ halfSpacing) + extent:[((width // 4 * 3) - spacing - borderWidth) + @ + (filterField heightIncludingBorder) + "(font height + font descent)" + ]. + labelView adjust:#right. + labelView borderWidth:0. + self initializeLabelMiddleButtonMenu. + + killButton := Button label:(resources string:'kill') in:self. + killButton origin:(halfSpacing @ halfSpacing) + extent:[(killButton width) + @ + (filterField heightIncludingBorder) + ]. + killButton hidden:true. + + frame := VariableVerticalPanel + origin:[frame borderWidth negated + @ + (labelView height + labelView origin y + spacing) + ] + extent:[width + @ + (height - spacing - labelView height - borderWidth) + ] + in:self. + + topFrame := ScrollableView for:SelectionInListView in:frame. + topFrame origin:(0.0 @ 0.0) corner:(1.0 @ 0.3). + + fileListView := topFrame scrolledView. + fileListView action:[:lineNr | self fileSelect:lineNr]. + fileListView doubleClickAction:[:lineNr | self fileSelect:lineNr. + self fileGet]. + fileListView multipleSelectOk:true. + + v := self initializeSubViewIn:frame. + v origin:(0.0 @ 0.3) corner:(1.0 @ 1.0). + subView := v scrolledView. + (subView respondsTo:#directoryForFileDialog:) ifTrue:[ + subView directoryForFileDialog:currentDirectory + ]. + + ObjectMemory addDependent:self. +! + +initializeFilterPattern + "set an initial matchpattern - can be redefined in subclasses" + + filterField contents:'*' +! + +initializeSubViewIn:frame + "set up the contents view - can be redefined in subclasses for + different view types (SoundFileBrowser/ImageBrowsers etc.)" + + ^ HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:frame. +! + +currentDirectory:aDirectoryPath + "set the directory to be browsed" + + currentDirectory := FileDirectory directoryNamed:aDirectoryPath. + (subView respondsTo:#directoryForFileDialog:) ifTrue:[ + subView directoryForFileDialog:currentDirectory + ] +! + +realize + self initializeFileListMiddleButtonMenu. + super realize. +"/ self updateCurrentDirectory +! + +mapped + super mapped. + self updateCurrentDirectory +! + +initializeLabelMiddleButtonMenu + |labels selectors args| + + labelView notNil ifTrue:[ + labels := resources array:#( + 'copy path' + '-' + 'up' + 'change to home-directory' + 'change directory ...' + ). + + selectors := #( + copyPath + nil + changeToParentDirectory + changeToHomeDirectory + changeCurrentDirectory + ). + + args := Array new:5. + + DirectoryHistory size > 0 ifTrue:[ + labels := labels copyWith:'-'. + selectors := selectors copyWith:nil. + args := args copyWith:nil. + + DirectoryHistory do:[:dirName | + labels := labels copyWith:dirName. + selectors := selectors copyWith:#changeDirectoryTo:. + args := args copyWith:dirName + ] + ]. + + labelView + middleButtonMenu:(PopUpMenu + labels:labels + selectors:selectors + args:args + receiver:self + for:labelView). + + + ] +! + +initializeFileListMiddleButtonMenu + |labels| + + fileListView notNil ifTrue:[ + labels := resources array:#( + 'spawn' + 'get contents' + 'show info' + 'show full info' + 'fileIn' + '-' + 'update' + '-' + 'execute unix command ...' + '-' + 'remove' + 'rename ...' + '-' + 'display long list' + 'show all files' + '-' + 'create directory ...' + 'create file ...'). + + fileListView + middleButtonMenu:(PopUpMenu + labels:labels + selectors:#(fileSpawn + fileGet + fileGetInfo + fileGetLongInfo + fileFileIn + nil + updateCurrentDirectory + nil + fileExecute + nil + fileRemove + fileRename + nil + changeDisplayMode + changeDotFileVisibility + nil + newDirectory + newFile) + receiver:self + for:fileListView) + ] +! ! + +!FileBrowser methodsFor:'private'! + +showAlert:aString with:anErrorString + "show an alertbox, displaying the last Unix-error" + + anErrorString isNil ifTrue:[ + self warn:aString withCRs + ] ifFalse:[ + self warn:(aString , '\\(' , anErrorString , ')' ) withCRs + ] +! + +ask:question yesButton:yesButtonText action:aBlock + "common method to ask a yes/no question" + + self ask:question yesButton:yesButtonText noButton:'abort' action:aBlock +! + +ask:question yesButton:yesButtonText noButton:noButtonText action:aBlock + "common method to ask a yes/no question" + + "cache the box" + yesNoBox isNil ifTrue:[ + yesNoBox := YesNoBox new + ]. + yesNoBox title:question withCRs. + yesNoBox okText:(resources at:yesButtonText). + yesNoBox noText:(resources at:noButtonText). + yesNoBox okAction:aBlock. + yesNoBox showAtPointer +! + +askIfModified:question yesButton:yesButtonText action:aBlock + "tell user, that code has been modified - let her confirm" + + (subView modified not or:[subView contentsWasSaved]) ifTrue:[ + aBlock value. + ^ self + ]. + self ask:question yesButton:yesButtonText action:aBlock +! + +withoutHiddenFiles:aCollection + "remove hidden files (i.e. those that start with '.') from + the list in aCollection" + + |newCollection| + + newCollection := aCollection species new. + aCollection do:[:fname | + ((fname startsWith:'.') and:[(fname = '..') not]) ifTrue:[ + showDotFiles ifTrue:[ + newCollection add:fname + ] + ] ifFalse:[ + newCollection add:fname + ] + ]. + ^ newCollection +! + +getInfoFile + "get filename of a description-file (.dir.info); + uncomment stuff below if you want this to also + automatically show contents of README files." + + #( '.dir.info' +"you can add these if you like ..." +" + 'README' + 'ReadMe' + 'Readme' + 'readme' +" + ) do:[:f | + (currentDirectory isReadable:f) ifTrue:[^ f]. + ]. + ^ nil +! + +showInfo:info + "show directory info when dir has changed" + + info notNil ifTrue:[ + self show:(self readFile:info) + ] ifFalse:[ + self show:nil. + ] +! + +getSelectedFileName + "returns the currently selected file; shows an error if + multiple files are selected" + + |sel| + + sel := fileListView selection. + (sel isKindOf:Collection) ifTrue:[ + self onlyOneSelection + ] ifFalse:[ + sel notNil ifTrue:[ + ^ fileList at:sel + ] + ]. + ^ nil +! + +getFileInfoString:longInfo + "get stat info on selected file - return a string which can be + shown in a box" + + |fileName fullPath text info stream fileOutput type modeBits modeString s| + + fileName := self getSelectedFileName. + fileName isNil ifTrue:[^ nil]. + + info := currentDirectory infoOf:fileName. + info isNil ifTrue:[ + self showAlert:(resources string:'cannot get info of ''%1'' !!' with:fileName) + with:(OperatingSystem lastErrorString). + ^ nil + ]. + + text := Text new. + type := info at:#type. + (longInfo and:[type == #regular]) ifTrue:[ + fullPath := currentDirectory pathName , '/' , fileName. + stream := PipeStream readingFrom:('file ' , fullPath). + stream notNil ifTrue:[ + fileOutput := stream contents asString. + stream close. + fileOutput := fileOutput copyFrom:(fileOutput indexOf:$:) + 1. + fileOutput := fileOutput withoutSeparators + ] + ]. + + s := (resources at:'type: '). + fileOutput isNil ifTrue:[ + s := s , type asString + ] ifFalse:[ + s := s , 'regular (' , fileOutput , ')' + ]. + text add:s. + text add:(resources at:'size: ') , (info at:#size) printString. + + modeBits := (info at:#mode). + modeString := self getModeString:modeBits. + longInfo ifTrue:[ + text add:((resources at:'access: ') + , modeString + , ' (' , (modeBits printStringRadix:8), ')' ) + ] ifFalse:[ + text add:(resources at:'access: ') , modeString + ]. + text add:(resources at:'owner: ') + , (OperatingSystem getUserNameFromID:(info at:#uid)). + longInfo ifTrue:[ + text add:(resources at:'group: ') + , (OperatingSystem getGroupNameFromID:(info at:#gid)). + text add:(resources at:'last access: ') + , (info at:#accessTime) asTime printString + , ' ' + , (info at:#accessTime) asDate printString. + text add:(resources at:'last modification: ') + , (info at:#modificationTime) asTime printString + , ' ' + , (info at:#modificationTime) asDate printString. + + ]. + ^ text asString +! + +getModeString:modeBits + "convert file-mode bits into a more user-friendly string. + This is wrong here - should be moved into OperatingSystem." + + |bits modeString| + + bits := modeBits bitAnd:8r777. + modeString := ''. + + #( nil 8r400 8r200 8r100 nil 8r040 8r020 8r010 nil 8r004 8r002 8r001 ) + with: #( 'owner:' $r $w $x ' group:' $r $w $x ' others:' $r $w $x ) do:[:bitMask :access | + bitMask isNil ifTrue:[ + modeString := modeString , (resources string:access) + ] ifFalse:[ + (bits bitAnd:bitMask) == 0 ifTrue:[ + modeString := modeString copyWith:$- + ] ifFalse:[ + modeString := modeString copyWith:access + ] + ] + ]. + ^ modeString +! + +checkIfDirectoryHasChanged + "every checkDelta secs, check if directoy has changed and update view if so" + + |oldSelection nOld here| + + shown ifTrue:[ + currentDirectory notNil ifTrue:[ + here := currentDirectory pathName. + (OperatingSystem isReadable:here) ifTrue:[ + Processor removeTimedBlock:checkBlock. + + (currentDirectory timeOfLastChange > timeOfLastCheck) ifTrue:[ + nOld := fileListView numberOfSelections. + oldSelection := fileListView selectionValue. + self updateCurrentDirectory. + nOld ~~ 0 ifTrue:[ + nOld > 1 ifTrue:[ + oldSelection do:[:element | + fileListView addElementToSelection:element + ] + ] ifFalse:[ + fileListView selectElement:oldSelection + ] + ] + ] ifFalse:[ + Processor addTimedBlock:checkBlock afterSeconds:checkDelta + ] + ] ifFalse:[ + " + if the directory has been deleted, or is not readable ... + " + (OperatingSystem isValidPath:here) ifFalse:[ + self warn:(resources string:'FileBrowser:\\directory %1 is gone ?!!?' with:here) withCRs + ] ifTrue:[ + self warn:(resources string:'FileBrowser:\\directory %1 is no longer readable ?!!?' with:here) withCRs + ]. + fileListView contents:nil. + self label:(myName , ': directory is gone !!'). + "/ Processor addTimedBlock:checkBlock afterSeconds:checkDelta + ] + ] + ] +! + +sizePrintString:size + "helper for update-directory to return a string with a files size. + This one gives the size in byte, Kb or Mb depending on size. + If you dont like this, just uncomment the first statement below." + + |unitString sizeString| + +" + ^ size printString. +" + unitString := ''. + size < (500 * 1024) ifTrue:[ + size < (1024) ifTrue:[ + sizeString := size printString + ] ifFalse:[ + sizeString := (size * 10 // 1024 / 10.0) printString. + unitString := 'Kb' + ] + ] ifFalse:[ + sizeString := (size * 10 // 1024 // 1024 / 10.0) printString. + unitString := 'Mb' + ]. + (sizeString includes:$.) ifFalse:[ + sizeString := sizeString , ' ' + ]. + ^ (sizeString printStringLeftPaddedTo:5) , unitString. +! + +updateCurrentDirectory + "update listView with directory contents" + + |files text len line info modeString typ + prevUid prevGid nameString groupString matchPattern + myProcess myPriority| + + self withCursor:(Cursor read) do:[ + Processor removeTimedBlock:checkBlock. + + labelView label:(currentDirectory pathName). + timeOfLastCheck := Time now. + + files := currentDirectory asOrderedCollection. + + matchPattern := filterField contents. + (matchPattern notNil and:[ + matchPattern isEmpty not and:[ + matchPattern ~= '*']]) ifTrue:[ + files := files select:[:aName | + ((currentDirectory typeOf:aName) == #directory) + or:[matchPattern match:aName] + ]. + ]. + files sort. + + files size == 0 ifTrue:[ + self notify:('directory ', currentDirectory pathName, ' vanished'). + ^ self + ]. + files := self withoutHiddenFiles:files. + + " + this is a time consuming operation (especially, if reading an + NFS-mounted directory); therefore lower my priority while getting + the files info ... + " + myProcess := Processor activeProcess. + myPriority := myProcess priority. + myProcess priority:(Processor userBackgroundPriority). + [ + fileList := files. + showLongList ifTrue:[ + text := OrderedCollection new. + files do:[:aFileName | + " + if multiple FileBrowsers are reading, let others + make some progress too + " + Processor yield. + + len := aFileName size. + (len < 20) ifTrue:[ + line := aFileName , (String new:(22 - len)) + ] ifFalse:[ + "can happen on BSD only" + line := (aFileName copyTo:20) , ' ' + ]. + info := currentDirectory infoOf:aFileName. + info isNil ifTrue:[ + "not accessable - usually a symlink, + which is not there/not readable + " + text add:line , '? bad symbolic link' + ] ifFalse:[ + typ := (info at:#type) at:1. + (typ == $r) ifFalse:[ + line := line , typ asString , ' ' + ] ifTrue:[ + line := line , ' ' + ]. + + modeString := self getModeString:(info at:#mode). + line := line , modeString , ' '. + + ((info at:#uid) ~~ prevUid) ifTrue:[ + prevUid := (info at:#uid). + nameString := OperatingSystem getUserNameFromID:prevUid. + nameString := nameString , (String new:(10 - nameString size)) + ]. + line := line , nameString. + ((info at:#gid) ~~ prevGid) ifTrue:[ + prevGid := (info at:#gid). + groupString := OperatingSystem getGroupNameFromID:prevGid. + groupString := groupString , (String new:(10 - groupString size)) + ]. + line := line , groupString. + + (typ == $r) ifTrue:[ + line := line , (self sizePrintString:(info at:#size)) + ]. + text add:line + ]. + ]. + ] ifFalse:[ + text := files collect:[:aName | + " + if multiple FileBrowsers are reading, let others + make some progress too + " + Processor yield. + (((currentDirectory typeOf:aName) == #directory) and:[ + (aName ~= '..') and:[aName ~= '.']]) ifTrue:[ + aName , ' ...' + ] ifFalse:[ + aName + ] + ]. + ]. + fileListView setContents:text + ] valueNowOrOnUnwindDo:[ + myProcess priority:myPriority. + ]. + + " + install a new check after some time + " + Processor addTimedBlock:checkBlock afterSeconds:checkDelta + ] +! + +doChangeCurrentDirectoryTo:fileName updateHistory:updateHistory + "verify argument is name of a readable & executable directory + and if so, go there" + + |msg| + + self label:myName. + fileName notNil ifTrue:[ + (currentDirectory isDirectory:fileName) ifTrue:[ + (currentDirectory isReadable:fileName) ifTrue:[ + (currentDirectory isExecutable:fileName) ifTrue:[ + updateHistory ifTrue:[ + (DirectoryHistory includes:(currentDirectory pathName)) ifFalse:[ + DirectoryHistory addFirst:currentDirectory pathName. + DirectoryHistory size > HistorySize ifTrue:[ + DirectoryHistory removeLast + ]. + self initializeLabelMiddleButtonMenu + ] + ]. + + ^ self setCurrentDirectory:fileName + ]. + msg := (resources string:'cannot change directory to ''%1'' !!' with:fileName) + ] ifFalse:[ + msg := (resources string:'cannot read directory ''%1'' !!' with:fileName) + ] + ] ifFalse:[ + msg := (resources string:'''%1'' is not a directory !!' with:fileName) + ]. + self showAlert:msg with:nil + ] +! + +doChangeToParentDirectory + "go to home directory" + + self doChangeCurrentDirectoryTo:'..' updateHistory:true +! + +doChangeToHomeDirectory + "go to home directory" + + self doChangeCurrentDirectoryTo:(OperatingSystem getHomeDirectory) updateHistory:true +! + +setCurrentDirectory:aPathName + "setup for another directory" + + |newDirectory info| + + aPathName isEmpty ifTrue:[^ self]. + (currentDirectory isDirectory:aPathName) ifTrue:[ + newDirectory := FileDirectory directoryNamed:aPathName in:currentDirectory. + newDirectory notNil ifTrue:[ + currentDirectory := newDirectory. + fileListView contents:nil. + self updateCurrentDirectory. + info := self getInfoFile. + self showInfo:info. + " + tell my subview (whatever that is) to start its file-dialog + (i.e. save-as etc.) in that directory + " + (subView respondsTo:#directoryForFileDialog:) ifTrue:[ + subView directoryForFileDialog:currentDirectory + ] + ] + ] +! + +readFile:fileName + "read in the file, answer its contents as Text" + + ^ self readFile:fileName lineDelimiter:Character cr +! + +readStream:aStream + "read in from aStream, answer its contents as Text" + + ^ self readStream:aStream lineDelimiter:Character cr +! + +readFile:fileName lineDelimiter:aCharacter + "read in the file, answer its contents as Text. The files lines are delimited by aCharacter." + + |stream text msg line sz| + + stream := FileStream readonlyFileNamed:fileName in:currentDirectory. + stream isNil ifTrue:[ + msg := (resources string:'cannot read file ''%1'' !!' with:fileName). + self showAlert:msg with:(FileStream lastErrorString). + ^ nil + ]. + + "for very big files, give ObjectMemory a hint, to preallocate more" + (sz := stream size) > 1000000 ifTrue:[ + ObjectMemory moreOldSpace:sz + ]. + + text := self readStream:stream lineDelimiter:aCharacter. + stream close. + ^ text +! + +readStream:aStream lineDelimiter:aCharacter + "read from aStream, answer its contents as Text. The files lines are delimited by aCharacter." + + |text msg line| + + aCharacter == Character cr ifTrue:[ + text := aStream contents + ] ifFalse:[ + text := Text new. + [aStream atEnd] whileFalse:[ + line := aStream upTo:aCharacter. + text add:line + ]. + ]. + ^ text +! + +writeFile:fileName text:someText + |stream msg startNr nLines string| + + self withCursor:(Cursor write) do:[ + stream := FileStream newFileNamed:fileName in:currentDirectory. + stream isNil ifTrue:[ + msg := (resources string:'cannot write file ''%1'' !!' with:fileName). + self showAlert:msg with:(FileStream lastErrorString) + ] ifFalse:[ + someText isString ifTrue:[ + stream nextPutAll:someText. + ] ifFalse:[ + "on some systems, writing linewise is very slow (via NFS) + therefore we convert to a string and write it in chunks + to avoid creating huge strings, we do it in blocks of 1000 lines + " + startNr := 1. + nLines := someText size. + [startNr <= nLines] whileTrue:[ + string := someText asStringFrom:startNr to:((startNr + 1000) min:nLines). + stream nextPutAll:string. + startNr := startNr + 1000 + 1. + ]. +"/ someText do:[:line | +"/ line notNil ifTrue:[ +"/ stream nextPutAll:line. +"/ ]. +"/ stream cr. +"/ ] + ]. + stream close. + subView modified:false + ] + ] +! + +doCreateDirectory:newName + (currentDirectory includes:newName) ifTrue:[ + self warn:(resources string:'%1 already exists.' with:newName) withCRs. + ^ self + ]. + + (currentDirectory createDirectory:newName) ifTrue:[ + self updateCurrentDirectory + ] ifFalse:[ + self showAlert:(resources string:'cannot create directory ''%1'' !!' with:newName) + with:(OperatingSystem lastErrorString) + ] +! + +doCreateFile:newName + |aStream box| + + (currentDirectory includes:newName) ifTrue:[ + box := YesNoBox new. + box title:(resources string:'%1 already exists\\truncate ?' with:newName) withCRs. + box okText:(resources string:'truncate'). + box noText:(resources string:'cancel'). + box noAction:[^ self]. + box showAtPointer + ]. + + aStream := FileStream newFileNamed:newName in:currentDirectory. + aStream notNil ifTrue:[ + aStream close. + self updateCurrentDirectory + ] ifFalse:[ + self showAlert:(resources string:'cannot create file ''%1'' !!' with:newName) + with:(FileStream lastErrorString) + ] +! + +showFile:fileName + "show contents of fileName in subView" + + |buffer s n i ok convert| + + ((currentDirectory typeOf:fileName) == #regular) ifFalse:[ + "clicked on something else - ignore it ..." + self show:(resources string:'''%1'' is not a regular file' with:fileName). + ^ self + ]. + " + check if file is a text file + " + s := FileStream readonlyFileNamed:fileName in:currentDirectory. + s isNil ifTrue:[ + self showAlert:(resources string:'cannot read file ''%1'' !!' with:fileName) + with:(FileStream lastErrorString). + ^ nil + ]. + + buffer := String new:300. + n := s nextBytes:300 into:buffer. + s close. + + ok := true. + 1 to:n do:[:i | + (buffer at:i) isPrintable ifFalse:[ok := false]. + ]. + ok ifFalse:[ + (self confirm:(resources string:'''%1'' seems to be a binary file - continue anyway ?' with:fileName)) + ifFalse:[^ self] + ]. + + convert := false. + ok ifTrue:[ + " + check if line delimiter is a cr + " + i := buffer indexOf:Character cr. + i == 0 ifTrue:[ + " + no newline found - try cr + " + i := buffer indexOf:(Character value:13). + i ~~ 0 ifTrue:[ + convert := self confirm:(resources string:'''%1'' seems to have CR as line delimiter - convert to NL ?' with:fileName). + ] + ] + ]. + + "release old text first - we might need the memory in case of huge files + (helps if you have a 4Mb file in the view, and click on another biggy)" + subView contents:nil. + + convert ifTrue:[ + self show:(self readFile:fileName lineDelimiter:(Character value:13)) + ] ifFalse:[ + self show:(self readFile:fileName). + ]. + subView acceptAction:[:theCode | + self writeFile:fileName text:theCode + ] +! + +show:something + "show something in subview and undef acceptAction" + + subView contents:something. + subView acceptAction:nil. + subView modified:false +! + +doFileGet + "get selected file - show contents in subView" + + |fileName| + + self withCursor:(Cursor read) do:[ + fileName := self getSelectedFileName. + fileName notNil ifTrue:[ + (currentDirectory isDirectory:fileName) ifTrue:[ + self doChangeCurrentDirectoryTo:fileName updateHistory:true. + self label:myName + ] ifFalse:[ + self showFile:fileName. + (currentDirectory isWritable:fileName) ifFalse:[ + self label:(myName , ': ' , fileName , ' (readonly)') + ] ifTrue:[ + self label:(myName , ': ' , fileName) + ] + ] + ] + ] +! + +doExecuteCommand:command replace:replace + "execute a unix command inserting the output of the command. + If replace is true, all text is replaced by the commands output; + otherwise, its inserted as selected text at the cursor position." + + |stream line lnr myProcess myPriority startLine startCol stopSignal + access| + + access := Semaphore forMutualExclusion. + stopSignal := Signal new. + + " + must take killButton out of my group + " + windowGroup removeView:killButton. + " + bring it to front, and turn hidden-mode off + " + killButton raise. + killButton hidden:false. + " + it will make me raise stopSignal when pressed + " + killButton action:[ + stream notNil ifTrue:[ + access critical:[ + myProcess interruptWith:[stopSignal raise]. + ] + ] + ]. + " + start it up under its own windowgroup + " + killButton openAutonomous. + + " + go fork a pipe and read it + " + self label:(myName , ': executing ' , (command copyTo:(20 min:command size)) , ' ...'). + [ + self withCursor:(Cursor wait) do:[ + stopSignal catch:[ + startLine := subView cursorLine. + startCol := subView cursorCol. + + stream := PipeStream readingFrom:('cd ' + , currentDirectory pathName + , '; ' + , command). + stream notNil ifTrue:[ + " + this can be a time consuming operation; therefore lower my priority + " + myProcess := Processor activeProcess. + myPriority := myProcess priority. + myProcess priority:(Processor userBackgroundPriority). + + [ + replace ifTrue:[ + subView list:nil. + lnr := 1. + ]. + + [stream atEnd] whileFalse:[ + stream readWait. + line := stream nextLine. + + " + need this critical section; otherwise, + we could get the signal while waiting for + an expose event ... + " + access critical:[ + line notNil ifTrue:[ + replace ifTrue:[ + subView at:lnr put:line. + lnr := lnr + 1. + ] ifFalse:[ + subView insertStringAtCursor:line. + subView insertCharAtCursor:(Character cr). + ] + ]. + + windowGroup processExposeEvents. + ]. + "/ + "/ give others running at same prio a chance too + "/ + Processor yield + ]. + ] valueNowOrOnUnwindDo:[ + stream close. stream := nil. + ]. + self updateCurrentDirectory + ]. + replace ifTrue:[ + subView modified:false. + ]. + ] + ] + ] valueNowOrOnUnwindDo:[ + |wg| + + self label:myName. + myProcess priority:myPriority. + + " + remove the killButton from its group + (otherwise, it will be destroyed when we shut down the group) + " + wg := killButton windowGroup. + killButton windowGroup:nil. + " + shut down the windowgroup + " + wg process terminate. + " + hide the button, and make sure it will stay + hidden when we are realized again + " + killButton unrealize. + killButton hidden:true. + " + clear its action (actually not needed, but + releases reference to thisContext earlier) + " + killButton action:nil. + ] +! + +initialCommandFor:fileName into:aBox + "set a useful initial command for execute box. + + XXX should be changed to take stuff from a config file + XXX or from resources." + + ((currentDirectory typeOf:fileName) == #regular) ifTrue:[ + + (currentDirectory isExecutable:fileName) ifTrue:[ + aBox initialText:(fileName , ''). + ^ self + ]. + + "some heuristics - my personal preferences ... + (actually this should come from a configfile)" + + (fileName endsWith:'akefile') ifTrue:[ + aBox initialText:'make target' selectFrom:6 to:11. + ^ self + ]. + (fileName endsWith:'.tar.Z') ifTrue:[ + aBox initialText:'zcat ' , fileName , ' | tar tvf -'. + ^ self + ]. + (fileName endsWith:'.taz') ifTrue:[ + aBox initialText:'zcat ' , fileName , ' | tar tvf -'. + ^ self + ]. + (fileName endsWith:'.tar') ifTrue:[ + aBox initialText:'tar tvf ' , fileName selectFrom:1 to:7. + ^ self + ]. + (fileName endsWith:'.zoo') ifTrue:[ + aBox initialText:'zoo -list ' , fileName selectFrom:1 to:9. + ^ self + ]. + (fileName endsWith:'.zip') ifTrue:[ + aBox initialText:'unzip -l ' , fileName selectFrom:1 to:8. + ^ self + ]. + (fileName endsWith:'.Z') ifTrue:[ + aBox initialText:'uncompress ' , fileName selectFrom:1 to:10. + ^ self + ]. + (fileName endsWith:'tar.gz') ifTrue:[ + aBox initialText:('gunzip <' , fileName , ' | tar tvf -' ). + ^ self + ]. + (fileName endsWith:'.gz') ifTrue:[ + aBox initialText:('gunzip <' , fileName , ' >' , (fileName copyTo:(fileName size - 3))). + ^ self + ]. + (fileName endsWith:'.uue') ifTrue:[ + aBox initialText:'uudecode ' , fileName selectFrom:1 to:8. + ^ self + ]. + (fileName endsWith:'.c') ifTrue:[ + aBox initialText:'cc -c ' , fileName selectFrom:1 to:5. + ^ self + ]. + (fileName endsWith:'.cc') ifTrue:[ + aBox initialText:'g++ -c ' , fileName selectFrom:1 to:6. + ^ self + ]. + (fileName endsWith:'.C') ifTrue:[ + aBox initialText:'g++ -c ' , fileName selectFrom:1 to:6. + ^ self + ]. + (fileName endsWith:'.xbm') ifTrue:[ + aBox initialText:'bitmap ' , fileName selectFrom:1 to:6. + ^ self + ]. + ((fileName endsWith:'.ps') or:[fileName endsWith:'.PS']) ifTrue:[ + aBox initialText:'ghostview ' , fileName selectFrom:1 to:9. + ^ self + ]. + ((fileName endsWith:'.1') + or:[fileName endsWith:'.man']) ifTrue:[ + aBox initialText:'nroff -man ' , fileName selectFrom:1 to:10. + ^ self + ]. + aBox initialText:' ' , fileName selectFrom:1 to:5 + ] +! + +askForCommandThenDo:aBlock + "setup and launch a querybox to ask for unix command. + Then evaluate aBlock passing the command-string as argument." + + |fileName sel box| + + box :=EnterBox new. + box initialText:''. + + sel := fileListView selection. + (sel isKindOf:Collection) ifFalse:[ + sel notNil ifTrue:[ + fileName := fileList at:sel + ] + ]. + fileName notNil ifTrue:[ + self initialCommandFor:fileName into:box. + ]. + box title:(resources at:'execute unix command:'). + box okText:(resources at:'execute'). + box action:aBlock. + box showAtPointer +! + +selectedFilesDo:aBlock + |sel files| + + sel := fileListView selection. + sel notNil ifTrue:[ + (sel isKindOf:Collection) ifTrue:[ + files := sel collect:[:index | fileList at:index]. + files do:[:aFile | + aBlock value:aFile + ] + ] ifFalse:[ + aBlock value:(fileList at:sel) + ] + ] + +! + +doRename:oldName to:newName + (oldName notNil and:[newName notNil]) ifTrue:[ + (oldName isBlank or:[newName isBlank]) ifFalse:[ + currentDirectory renameFile:oldName newName:newName. + self updateCurrentDirectory. +" + self checkIfDirectoryHasChanged +" + ] + ] +! + +doRemove + "remove the selected file(s) - no questions asked" + + |ok msg dir| + + self withCursor:(Cursor execute) do:[ + self selectedFilesDo:[:fileName | + (currentDirectory isDirectory:fileName) ifTrue:[ + dir := FileDirectory directoryNamed:fileName in:currentDirectory. + dir isEmpty ifFalse:[ + self ask:(resources string:'directory ''%1'' is not empty\remove anyway ?' with:fileName) + yesButton:'remove' + action:[currentDirectory removeDirectory:fileName] + ] ifTrue:[ + currentDirectory removeDirectory:fileName + ]. + ] ifFalse:[ + ok := currentDirectory remove:fileName. + ok ifFalse:[ + "was not able to remove it" + msg := (resources string:'cannot remove ''%1'' !!' with:fileName). + self showAlert:msg with:(OperatingSystem lastErrorString) + ] ifTrue:[ +" + self show:nil +" + ] + ] + ]. + self updateCurrentDirectory. + ] +! + +onlyOneSelection + "show a warning, that only one file must be selected for + this operation" + + self warn:(resources at:'exactly one file must be selected !!') +! ! + +!FileBrowser methodsFor:'user interaction'! + +fileSpawn + "start another FileBrowser on the selected directory or + on the same directory if none is selected." + + |any| + + any := false. + self selectedFilesDo:[:fileName | + (currentDirectory isDirectory:fileName) ifTrue:[ + self class openOn:(currentDirectory pathName , '/' , fileName). + any := true + ] + ]. + any ifFalse:[ + self class openOn:currentDirectory pathName + ] +! + +copyPath + "copy current path into cut & paste buffer" + + Smalltalk at:#CopyBuffer put:(currentDirectory pathName) +! + +fileExecute + "if text was modified show a queryBox, + otherwise pop up execute box immediately" + + |action| + +"/ action := [:command| self doExecuteCommand:command replace:true]. +"/ +"/ self askIfModified:(resources at:'contents has not been saved.\\Modifications will be lost when command is executed.') withCRs +"/ yesButton:(resources at:'execute') +"/ action:[self askForCommandThenDo:action] + + action := [:command| self doExecuteCommand:command replace:false]. + self askForCommandThenDo:action +! + +fileSelect:lineNr + "selected a file - do nothing here" + ^ self +! + +fileGet + "if text was modified show an queryBox, + otherwise get it immediately" + + |fileName msg label| + + (subView modified not or:[subView contentsWasSaved]) ifTrue:[^ self doFileGet]. + fileName := self getSelectedFileName. + fileName notNil ifTrue:[ + (currentDirectory isDirectory:fileName) ifTrue:[ + msg := (resources at:'contents has not been saved.\\Modifications will be lost when directory is changed.'). + label := 'change'. + ] ifFalse:[ + msg := (resources at:'contents has not been saved.\\Modifications will be lost when new file is read.'). + label := 'get'. + ]. + self ask:msg yesButton:label action:[self doFileGet] + ] +! + +filePrint + |fileName inStream printStream line| + + self withCursor:(Cursor execute) do:[ + fileName := self getSelectedFileName. + fileName notNil ifTrue:[ + ((currentDirectory typeOf:fileName) == #regular) ifTrue:[ + inStream := FileStream readonlyFileNamed:fileName + in:currentDirectory. + inStream isNil ifFalse:[ + printStream := PrinterStream new. + printStream notNil ifTrue:[ + [inStream atEnd] whileFalse:[ + line := inStream nextLine. + printStream nextPutAll:line. + printStream cr + ]. + printStream close + ]. + inStream close + ] + ] + ]. + 0 "compiler hint" + ] +! + +fileFileIn + "fileIn the selected file(s)" + + |aStream upd| + + self withCursor:(Cursor wait) do:[ + self selectedFilesDo:[:fileName | + ((currentDirectory typeOf:fileName) == #regular) ifTrue:[ + ((fileName endsWith:'.o') + or:[(fileName endsWith:'.so') + or:[fileName endsWith:'.obj']]) ifTrue:[ + Object abortSignal catch:[ + ObjectFileLoader loadObjectFile:(currentDirectory pathName , '/' ,fileName) + ] + ] ifFalse:[ + aStream := FileStream readonlyFileNamed:fileName in:currentDirectory. + aStream isNil ifFalse:[ + upd := Class updateChanges:false. + [ + Smalltalk systemPath addFirst:(currentDirectory pathName). + aStream fileIn. + Smalltalk systemPath removeFirst + ] valueNowOrOnUnwindDo:[ + Class updateChanges:upd. + aStream close + ] + ] + ] + ] + ] + ] +! + +fileRemove + "remove the selected file(s). + Query if user really wants to remove the file. + - should be enhanced, to look for a ~/.trash directory + and move files there if it exists (without asking in this case)." + + |sel q| + + sel := fileListView selection. + sel notNil ifTrue:[ + (sel isKindOf:Collection) ifTrue:[ + q := resources string:'remove selected files ?' + ] ifFalse:[ + q := resources string:'remove ''%1'' ?' with:(fileList at:sel) + ]. + self ask:q yesButton:'remove' action:[self doRemove] + ] +! + +newDirectory + "ask for and create a new directory" + + queryBox isNil ifTrue:[ + queryBox := FilenameEnterBox new + ]. + queryBox initialText:''. + queryBox title:(resources at:'create new directory:') withCRs. + queryBox okText:(resources at:'create'). + "queryBox abortText:(resources at:'abort')." + queryBox action:[:newName | self doCreateDirectory:newName]. + queryBox showAtPointer +! + +newFile + "ask for and create a new file" + + | sel | + + queryBox isNil ifTrue:[ + queryBox := FilenameEnterBox new + ]. + sel := subView selection. + sel notNil ifTrue:[ + queryBox initialText:(sel asString) + ] ifFalse:[ + queryBox initialText:'' + ]. + queryBox title:(resources at:'create new file:') withCRs. + queryBox okText:(resources at:'create'). + "queryBox abortText:(resources at:'abort')." + queryBox action:[:newName | self doCreateFile:newName]. + queryBox showAtPointer +! + +fileRename + "rename the selected file(s)" + + queryBox isNil ifTrue:[ + queryBox := FilenameEnterBox new + ]. + queryBox okText:(resources at:'rename'). + "queryBox abortText:(resources at:'abort')." + self selectedFilesDo:[:oldName | + queryBox title:(resources string:'rename ''%1'' to:' with:oldName). + queryBox initialText:oldName. + queryBox action:[:newName | self doRename:oldName to:newName]. + queryBox showAtPointer + ] +! + +terminate + "exit FileBrowser" + + self askIfModified:(resources at:'contents has not been saved.\\Modifications will be lost when FileBrowser is closed.') withCRs + yesButton:(resources at:'close') + action:[self destroy] +! + +destroy + "destroy view and boxes" + + ObjectMemory removeDependent:self. + Processor removeTimedBlock:checkBlock. + checkBlock := nil. + yesNoBox notNil ifTrue:[yesNoBox destroy. yesNoBox := nil]. + queryBox notNil ifTrue:[queryBox destroy. queryBox := nil]. + super destroy +! + +update:what + (what == #aboutToExit) ifTrue:[ + "system wants to shut down this + - if text was modified, pop up, and ask user and save if requested." + + (subView modified and:[subView contentsWasSaved not]) ifTrue:[ + shown ifFalse:[ + self unrealize. + self realize + ]. + self raise. + " + mhmh: I dont like this - need some way to tell windowGroup to handle + all pending exposures ... + " + self withAllSubViewsDo:[:view | view redraw]. + + self ask:(resources at:'FileBrowser:\\contents has not been saved.\\Save before exiting ?') withCRs + yesButton:'save' + noButton:'don''t save' + action:[ + subView acceptAction notNil ifTrue:[ + subView accept + ] ifFalse:[ + subView save + ] + ] + ]. + ^ self + ]. + super update:what + +! + +changeDirectoryTo:aDirectoryName + "sent from label menu to change back to a previous directory" + + self doChangeCurrentDirectoryTo:aDirectoryName updateHistory:false +! + +changeCurrentDirectory + "if text was modified show a queryBox, + otherwise change immediately to directory" + + self askIfModified:(resources at:'contents has not been saved.\\Modifications will be lost when directory is changed.') withCRs + yesButton:(resources at:'change') + action:[self queryForDirectoryToChange] +! + +changeToParentDirectory + "if text was modified show a queryBox, + otherwise change immediately to directory" + + self askIfModified:(resources at:'contents has not been saved.\\Modifications will be lost when directory is changed.') withCRs + yesButton:(resources at:'change') + action:[self doChangeToParentDirectory] +! + +changeToHomeDirectory + "if text was modified show a queryBox, + otherwise change immediately to directory" + + self askIfModified:(resources at:'contents has not been saved.\\Modifications will be lost when directory is changed.') withCRs + yesButton:(resources at:'change') + action:[self doChangeToHomeDirectory] +! + +queryForDirectoryToChange + "query for new directory" + + queryBox isNil ifTrue:[ + queryBox := FilenameEnterBox new + ]. + queryBox initialText:''. + queryBox title:(resources at:'change directory to:') withCRs. + queryBox okText:(resources at:'change'). + "queryBox abortText:(resources at:'abort')." + queryBox action:[:newName | self doChangeCurrentDirectoryTo:newName updateHistory:true]. + queryBox showAtPointer +! + +fileGetInfo:longInfo + "get info on selected file - show it in a box" + + |string| + + string := self getFileInfoString:longInfo. + string notNil ifTrue:[ + self information:string + ] +! + +fileGetLongInfo + "triggered by menu: show long stat-info" + + self fileGetInfo:true +! + +fileGetInfo + "triggered by menu: show short stat-info" + + self fileGetInfo:false +! + +changeDisplayMode + "toggle from long to short listing (and vice-versa)" + + |long short| + + long := (resources at:'display long list'). + short := (resources at:'display short list'). + + showLongList := showLongList not. + showLongList ifFalse:[ + fileListView middleButtonMenu labelAt:short put:long + ] ifTrue:[ + fileListView middleButtonMenu labelAt:long put:short + ]. + self updateCurrentDirectory +! + +changeDotFileVisibility + "turn on/off visibility of files whose name starts with '.'" + + |show dontShow| + + show := (resources at:'show all files'). + dontShow := (resources at:'hide hidden files'). + + showDotFiles := showDotFiles not. + showDotFiles ifFalse:[ + fileListView middleButtonMenu labelAt:dontShow put:show + ] ifTrue:[ + fileListView middleButtonMenu labelAt:show put:dontShow + ]. + self updateCurrentDirectory +! !