maclab@reed.UUCP (Mac DLab) (05/10/86)
Here is the Rascal source to Utils. There are several files, but they
are small enough that I think it is simplest to just concatenate
them in text form.
The sources:
sUtils.src: Main program body.
__Filter.src: library to handle command key equivalents in SFGetFile.
sDelete.src: Does the deleting.
sRename.src: Does the renaming.
sCopy.src: Does the copying.
Note that sCopy, sDelete, and sRename can all be standalone programs:
just compile/link/execute. sUtils treats sdelete,scopy,srename as
libraries -- compile/link/execute of sUtils will bring the whole thing
together.
Scott "Comments, what comments?" Gillespie
---------------------------------------------------------------------------
Program __Filter;
Uses __DeskLib, __ToolTraps,
(*$U+*) uOSIntf, uToolIntf, uPackIntf ;
Link __DeskLib, __SFNames :;
Type
FileName = Byte[64];
Var
Mid: Integer;
ButtonName: Filename;
Func isCommKey():Boolean;
Var
E: EventRecord;
{
if GetNextEvent(0,E) Then ;
Return((E.Modifiers and CmdKey)<>0);
};
Function ThePutFilter(item:Integer; dlog: Dialogptr): Integer; Clean;
Var t: Integer;
hand: controlhandle;
box: rect;
{
DAClean(False);
ThePutFilter := item;
if item=-1 Then {
GetDItem(dlog,PutSave,@t,@hand,@box);
SetCTitle(hand,ButtonName);
};
};
Function TheGetFilter(item:Integer; dlog: Dialogptr): Integer; Clean;
Var t: Integer;
hand: controlhandle;
box: rect;
{
DAClean(False);
TheGetFilter := item;
Case item of
-1:
{
GetDItem(dlog,GetOpen,@t,@hand,@box);
SetCTitle(hand,ButtonName);
};
OtherWise
If item>1000 Then
If isCommKey() Then {
Case item mod 256 of
'd': item := GetDrive;
'e': item := GetEject;
'c': item := GetCancel;
Otherwise
Return(0);
End;
GetDItem(dlog,item,@t,@hand,@box);
If hand^^.ContrlHilite = 0 Then {
HiliteControl(Hand,1);
Return(item);
};
TheGetFilter := 0;
};
End;
};
Proc SetButtonName(n: Filename);
{
ButtonName := n;
};
PROCEDURE Filtergetfile(x,y:integer;
nameptr,
typelist: ptrL;
ntypes: integer;
vref,good: ptrw);
begin
HookGetFile(x,y,nameptr,typelist,ntypes,vref,good,@TheGetFilter);
end;
PROCEDURE Filterputfile(x,y: integer;
name,message: ptrb;
nameptr: ptrL;
vref,good: ptrw);
begin
HookPutFile(x,y,name,message,nameptr,vref,good,@ThePutFilter);
End;
---------------------------------------------------------------------------
Program sDelete;
Uses __OSTraps, __SFNames, __Filter
(*$U+*) uPackIntf ;
Link __Filter, __SFNames, __NoSysCall,
__OSTraps, __DeskLib, __ToolLink : ;
Procedure DoDelete();
var vref,good: integer;
name: ptrb;
{
DAClean(True);
SetButtonName("Delete!");
loop(,,,!good) {
Filtergetfile(100,70,@name,"",-1,@vref,@good);
If Good Then
If FSDelete(name,vref) then
SysBeep(4);
};
};
procedure _Init();
{
DAClean(True);
DoDelete();
reqhalt();
};
---------------------------------------------------------------------------
Program sRename;
Uses __OSTraps, __DeskLib, __Filter
(*$U+*) uOSIntf ;
Link __Filter, __NoSysCall, __SFNames, __OSTraps, __DeskLib : ;
Proc DoRename();
Type
FileName = Byte[64];
Var
ok,vref,dummy: Integer;
nameptr: ^FileName;
Name: FileName;
{
DAClean(True);
Loop(,,,) {
SetButtonName("Rename");
FilterGetFile(100,70,@nameptr,"",-1,@vref,@ok);
if !ok Then Break;
Name := NamePtr^;
SetButtonName("Change");
FilterPutFile(100,70,name,"Change Name To:",@nameptr,@dummy,@ok);
if !ok Then Continue;
if Rename(Name,vref,nameptr) Then
SysBeep(4);
};
};
Proc _Init();
{
DAClean(True);
DoRename();
ReqHalt();
};
---------------------------------------------------------------------------
Program sCopy;
(* by Scott Gillespie *)
Uses __OSTraps, __ToolTraps, __DeskLib, __Filter
(*$U+*) uPackIntf, uToolIntf, uOSIntf ;
Link __Filter, __NoSysCall, __SFNames, __OSTraps, __DeskLib :;
Type
FileName = Byte[64];
Function copyfile(fromref,toref: integer): boolean;
(*
Given two file reference numbers, this procedure will copy the
contents of the first file to the second. The more memory there
is available, the fewer number of swaps or reads are required.
*** This procedure CLOSES the files after the copy is finished!!!
*)
var Length: longint;
BlockSize: longint;
CBlock: ptrL;
Total,Count: longint;
err,i: integer;
{
copyfile := True;
err := 0;
flength(fromref,@length);
BlockSize := CompactMem(length);
If BlockSize > Length then
BlockSize := Length;
If BlockSize > 32760 Then
BlockSize := 32760;
Total := 0;
CBlock := NewPtr(BlockSize);
loop(,i:=0,++i,(Total>=Length) or err) {
Count := Length - Total;
If Count > BlockSize Then
Count := BlockSize;
fread(fromref,CBlock,@Count);
Total := Total+Count;
If Total>=Length Then FClose(fromref);
if !i Then fseteof(toref,0L);
fwrite(toref,CBlock,Integer(Count));
If Total>=Length Then FClose(toref);
ferr(@err);
(* Writechar('.'); *)
};
if err then {
fclose(fromref);
fclose(toref);
copyfile := False;
};
DisposPtr(CBlock);
};
proc failed(f1,f2: integer);
{
if f1 Then fclose(f1);
if f2 Then fclose(f2);
(* Writeln();
Writestring("Copy Failed...."); *)
};
Func QuickCopy(FromN: FileName; FromV: Integer;
ToN: FileName; ToV : Integer): Boolean;
var
io,curVol: Integer;
FromRef,ToRef: Integer;
Finf : FInfo;
{
QuickCopy := False;
io := getvol(Nil,@curvol);
io := OpenRF(FromN,FromV,@FromRef);
if io Then {failed(0,0); return };
io := OpenRF(ToN,ToV,@ToRef);
if io Then {
io := setvol(Nil,ToV);
CreateResFile(ToN);
io := OpenRF(ToN,ToV,@ToRef);
if io Then { Failed(fromRef,0); Return };
io := SetVol(Nil,curvol);
}
else
fseteof(ToRef,0L);
if !Copyfile(FromRef,ToRef) Then {
io := FSDelete(ToN,ToV);
Failed(0,0);
Return
};
fopen(@FromRef,FromN,0,FromV);
ferr(@io);
if io Then {failed(0,0); return };
fcreate(ToN," ????"+2," ????"+2,Tov);
fopen(@ToRef,@ToN,3,ToV);
ferr(@io);
if io Then {failed(fromRef,toref); return };
fseteof(ToRef,0L);
if !Copyfile(FromRef,ToRef) Then {
io := FSDelete(ToN,ToV);
Failed(0,0);
Return
};
io := GetFInfo(FromN,FromV,FInf);
Finf.fdFlags and= 254;
Finf.fdLocation.vh := 0;
Finf.fdFldr := 0;
io := SetFInfo(ToN,ToV, Finf);
QuickCopy := True;
(* writeln();
writestring("Copy was Successful.... ");*)
};
Proc DoCopy();
Var
ok,vref,nextvref: Integer;
nameptr: ^FileName;
Name: FileName;
{
DAClean(True);
Loop(,,,) {
SetButtonName("Copy");
FilterGetFile(100,70,@nameptr,"",-1,@vref,@ok);
if !ok Then Break;
Name := NamePtr^;
SetButtonName("Do Copy");
FilterPutFile(100,70,name,"Copy To: ",@nameptr,@nextvref,@ok);
if !ok Then Continue;
if !QuickCopy(Name,vref,nameptr,nextvref) Then
SysBeep(4);
};
};
Proc _Init();
{
DAClean(True);
DoCopy();
ReqHalt();
};