home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR13
/
4UTILS76.ZIP
/
4DESC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-10-31
|
30KB
|
891 lines
PROGRAM FileDescEditor;
{$A+,B-,D-,E-,F-,G+,L+,N-,O-,R+,S+,V-,X-}
{$M 8192,0,655360}
(* ----------------------------------------------------------------------
A Simple 4DOS File Description Editor
(c) 1992, 1993 Copyright by
David Frey, & Tom Bowden
Urdorferstrasse 30 1575 Canberra Drive
8952 Schlieren ZH Stone Mountain, GA 30088-3629
Switzerland USA
Code created using Turbo Pascal 7.0, (c) Borland International 1992
DISCLAIMER: This program is freeware: you are allowed to use, copy
and change it free of charge, but you may not sell or hire
4DESC. The copyright remains in our hands.
If you make any (considerable) changes to the source code,
please let us know. (send a copy or a listing).
We would like to see what you have done.
We, David Frey and Tom Bowden, the authors, provide absolutely
no warranty of any kind. The user of this software takes the
entire risk of damages, failures, data losses or other
incidents.
----------------------------------------------------------------------- *)
USES {$IFOPT G+} Test286, {$ENDIF}
Crt, Dos, Memory,
StringDateHandling, DisplayKeyboardAndCursor, HandleINIFile,
DescriptionHandling, Dmouse;
CONST DelimiterTable : STRING = ',.();:-!?/[]{}+*=''`"@%&$_£';
VAR EdStart : BYTE; (* column where the description starts *)
ActDir : DirStr; (* current directory *)
StartDir : DirStr; (* directory where we started from *)
StartIndex : INTEGER; (* index of entry at the top of the screen *)
Index : INTEGER; (* index of entry we are editing *)
CutPasteDesc: DescStr; (* cut, resp. pasted description *)
Changed : BOOLEAN; (* TRUE=the descriptions have been edited *)
IORes : INTEGER;
NewDir : DirStr; (* temporary storage for a directory path, *)
NewName : NameStr; (* used by view and others *)
NewExt : ExtStr;
FirstParam : STRING[2];
i : BYTE; (* variable for counting (index etc) *)
ShowHelp : BOOLEAN; (* TRUE = start in help mode [/h] *)
s : STRING; (* temporary string variable *)
(*-------------------------------------------------------- Display-Routines *)
PROCEDURE DisplayFileEntry(Index: INTEGER; x: BYTE; Hilighted: BOOLEAN);
(* Displays the Index'th file entry. If the description is longer than
DispLen characters, DispLen characters - starting at character x of the
description - will be shown. (this feature is needed for scrolling).
Hilighted = TRUE will hilight the description.
P.S. Scrolling implies hilighting, but this fact has not been exploited. *)
VAR FileEntry : PFileData;
xs,y,l : BYTE;
BEGIN
y := 3+Index-StartIndex;
GotoXY(1,y);
IF (Index >= 0) AND (Index < FileList^.Count) THEN
BEGIN
FileEntry := NILCheck(FileList^.At(Index));
IF Hilighted THEN
BEGIN TextColor(SelectFg); TextBackGround(SelectBg); END
ELSE
BEGIN
TextBackGround(NormBg);
IF FileEntry^.GetSize <> DirSize THEN TextColor(NormFg)
ELSE TextColor(DirFg)
END;
l := Length(FileEntry^.GetDesc);
IF x <= DispLen THEN xs := 1
ELSE xs := x-DispLen+1;
Write(FileEntry^.FormatScrollableDescription(xs,DispLen));
IF l-xs < DispLen THEN
ClrEol
ELSE
BEGIN
TextColor(WarnFg); Write('»'); TextColor(NormFg);
END;
IF x <= DispLen THEN GotoXY(EdStart+x-1,y)
ELSE GotoXY(EdStart+DispLen-1,y)
END
ELSE ClrEol;
END; (* DisplayFileEntry *)
PROCEDURE DrawDirLine;
(* Draw the line, which tells us where in the directory tree we are. *)
BEGIN
GetDir(0,ActDir);
IF ActDir[Length(ActDir)] <> '\' THEN ActDir := ActDir + '\';
UpString(ActDir);
TextColor(DirFg); TextBackGround(NormBg);
GotoXY(1,2); Write(' ',ActDir); ClrEol;
END; (* DrawDirLine *)
PROCEDURE ReDrawScreen;
(* Redraws the full screen, needed after shelling out or after printing
the help screen. *)
VAR Index: INTEGER;
BEGIN
GetDir(0,ActDir);
FOR Index := StartIndex TO StartIndex+MaxLines-4 DO
DisplayFileEntry(Index,1,FALSE);
END; (* ReDrawScreen *)
(*-------------------------------------------------------- Read-Directory *)
PROCEDURE ReadFiles;
(* Scan the current directory and read in the DESCRIPT.ION file. Build a
file list database and associate the right description.
Warn the user if there are too long descriptions or if there are too
much descriptions. *)
VAR i : BYTE;
ch : WORD;
Dir : PathStr;
BEGIN
Changed := FALSE;
DescLong := FALSE;
Index := 0;
StartIndex := 0;
Dir := FExpand('.');
IF FileList <> NIL THEN
BEGIN
Dispose(FileList,Done); FileList := NIL;
END;
TextColor(StatusFg); TextBackGround(StatusBg);
GotoXY(1,MaxLines);
Write(Chars(' ',((ScreenWidth-40+Length(Dir)) DIV 2)),
'Scanning directory ',Dir,' ..... please wait.');
ClrEol;
FileList := NIL; FileList := New(PFileList,Init(Dir));
IF FileList = NIL THEN Abort('Unable to allocate FileList');
IF (FileList^.Status = ListTooManyFiles) OR
(FileList^.Status = ListOutofMem) THEN
BEGIN
TextColor(NormFg); TextBackGround(NormBg);
FOR i := 3 TO MaxLines-1 DO
BEGIN
GotoXY(1,i); ClrEol;
END;
IF FileList^.Status = ListTooManyFiles THEN
ReportError('Warning! Too many files in directory, description file will be truncated! (Key)',(CutPasteDesc <> ''),Changed)
ELSE
ReportError('Warning! Out of memory, description file will be truncated! (Key)',(CutPasteDesc <> ''),Changed);
END;
IF FileList^.Count > 0 THEN
BEGIN
DrawMainScreen(Index,FileList^.Count);
DrawDirLine;
END;
IF DescLong THEN
BEGIN
TextColor(NormFg); TextBackGround(NormBg);
FOR i := 3 TO MaxLines-1 DO
BEGIN
GotoXY(1,i); ClrEol;
END;
ReportError('Warning! Some descriptions are too long; they will be truncated. Press any key.',(CutPasteDesc <> ''),Changed);
END;
END; (* ReadFiles *)
(*-------------------------------------------------------- Save Descriptions *)
PROCEDURE SaveDescriptions;
(* Save the modified descriptions currently held in memory onto disk.
Rename the old description file into DESCRIPT.OLD and write the
new one out. Any problems occuring at this point (disk full etc),
raise a warning message and cause a deletion of the (half-written)
description file DESCRIPT.ION. In this case the user "only" looses his
new, edited descriptions, but the old ones are stored in the DESCRIPT.OLD
file and can be restored by typing
REN DESCRIPT.OLD DESCRIPT.ION
ATTRIB +H DESCRIPT.ION *)
VAR DescFile : TEXT;
DescSaved : BOOLEAN;
Time : DateTime;
ch : WORD;
FileEntry : PFileData;
PROCEDURE SaveEntry(FileEntry: PFileData); FAR;
(* Save a single description, writes a single line of the description
file. This procedures is called for each entry in the FileEntry list *)
VAR Desc : DescStr;
ProgInfo : STRING;
Dir : DirStr;
BaseName : NameStr;
Ext : ExtStr;
BEGIN
Desc := FileEntry^.GetDesc;
StripLeadingSpaces(Desc); StripTrailingSpaces(Desc);
IF Desc <> '' THEN
BEGIN
FSplit(FileEntry^.GetName,Dir,Basename,Ext);
StripTrailingSpaces(BaseName);
Write(DescFile,BaseName);
StripLeadingSpaces(Ext);
StripTrailingSpaces(Ext);
IF Ext <> '' THEN Write(DescFile,Ext);
Write(DescFile,' ',Desc);
IF DescSaved = FALSE THEN DescSaved := TRUE;
ProgInfo := FileEntry^.GetProgInfo;
IF ProgInfo <> '' THEN Write(DescFile,#4,ProgInfo);
WriteLn(DescFile);
END;
END; (* SaveEntry *)
BEGIN
DescSaved := FALSE;
IF DiskFree(0) < FileList^.Count*SizeOf(TFileData) THEN
ReportError('Probably out of disk space. Nevertheless trying to save DESCRIPT.ION...',(CutPasteDesc <> ''),Changed);
TextColor(StatusFg); TextBackGround(StatusBg);
GotoXY(1,MaxLines);
Write(Chars(' ',((ScreenWidth-41) div 2)),
'Saving descriptions........ please wait.');
ClrEol;
{$I-}
Assign(DescFile,'DESCRIPT.ION'); Rename(DescFile,'DESCRIPT.OLD'); IORes := IOResult;
Assign(DescFile,'DESCRIPT.ION'); SetFAttr(DescFile,Archive); IORes := IOResult;
Rewrite(DescFile);
{$I+}
IF IOResult > 0 THEN
BEGIN
ReportError('Unable to write DESCRIPT.ION !',(CutPasteDesc <> ''),Changed);
{$I-}
Assign(DescFile,'DESCRIPT.OLD'); Rename(DescFile,'DESCRIPT.ION'); IORes := IOResult;
{$I+}
END
ELSE
BEGIN
FileList^.ForEach(@SaveEntry);
{$I-}
Close(DescFile);
{$I+}
IF IOResult > 0 THEN
BEGIN
ReportError('Unable to write DESCRIPT.ION !',(CutPasteDesc <> ''),Changed);
{$I-}
Assign(DescFile,'DESCRIPT.OLD'); Rename(DescFile,'DESCRIPT.ION'); IORes := IOResult;
{$I+}
END
ELSE
BEGIN
IF DescSaved THEN SetFAttr(DescFile, Archive + Hidden)
ELSE Erase(DescFile); (* Don't keep zero-byte file. *)
Changed := FALSE; DrawStatusLine(TRUE,(CutPasteDesc <> ''),Changed);
{$I-}
Assign(DescFile,'DESCRIPT.OLD'); Erase(DescFile); IORes := IOResult;
{$I+}
END;
END;
END; (* SaveDescriptions *)
(*-------------------------------------------------------- Edit Descriptions *)
PROCEDURE EditDescriptions;
(* This is the heart of 4DESC: the editing of the descriptions.
The constants below are taken out from Turbo Pascal's help; any
completion is straight-forward. [ insert the appropriate key
definition in the constant section below and insert the associated
routine in the great CASE OF xxx branch below. ] *)
CONST kbLeft = $4B00; kbRight = $4D00;
kbUp = $4800; kbDown = $5000;
kbHome = $4700; kbEnd = $4F00;
kbPgUp = $4900; kbPgDn = $5100;
kbCtrlLeft = $7300; kbCtrlRight= $7400;
kbCtrlPgDn = $7600; kbCtrlPgUp = $8400;
kbCtrlHome = $7700; kbCtrlEnd = $7500;
kbEnter = $0D; kbEsc = $1B;
kbIns = $5200; kbDel = $5300;
kbBack = $08;
kbGrayMinus= $4A2D; kbGrayPlus = $4E2B;
kbAltC = $2E00; kbAltP = $1900;
kbAltD = $2000; kbAltL = $2600;
kbAltM = $3200; kbAltT = $1400;
kbAltS = $1F00; kbAltV = $2F00;
kbAltX = $2D00;
kbF1 = $3B00; kbF2 = $3C00;
kbF3 = $3D00; kbF4 = $3E00;
kbF5 = $3F00; kbF6 = $4000;
kbF10 = $4400; kbShiftF10 = $5D00;
VAR Key : WORD;
Drv : STRING[3];
LastDrv : CHAR;
x,y,l : BYTE;
EditStr : DescStr;
Overwrite : BOOLEAN;
Cursor : WORD;
OldDir : DirStr;
ActFileData : PFileData;
n : NameExtStr;
PROCEDURE UpdateLineNum(Index: INTEGER);
(* Update the line number indicator in the right corner and redraw
the associated description line *)
BEGIN
TextColor(StatusFg); TextBackGround(StatusBg);
GotoXY(66,1); Write(Index+1:5);
IF Changed THEN DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
IF Index < FileList^.Count THEN
BEGIN
EditStr := PFileData(FileList^.At(Index))^.GetDesc;
DisplayFileEntry(Index,1,TRUE);
END;
ActFileData := NILCheck(FileList^.At(Index));
END;
PROCEDURE PrevIndex(VAR Index: INTEGER);
(* Go up one description line (if possible) *)
BEGIN
Index := Max(Index-1,0);
IF Index <= StartIndex THEN
BEGIN
StartIndex := Max(Index-ScreenSize,0);
RedrawScreen;
END;
UpdateLineNum(Index);
END; (* PrevIndex *)
PROCEDURE NextIndex(VAR Index: INTEGER);
(* Go down one description line (if possible) *)
BEGIN
Index := Min(Index+1,FileList^.Count-1);
IF Index > StartIndex+ScreenSize THEN
BEGIN
StartIndex := Index-ScreenSize;
RedrawScreen;
END;
UpdateLineNum(Index);
END; (* NextIndex *)
PROCEDURE QuerySaveDescriptions;
(* Ask the user if he really wants to save the descriptions. *)
VAR ch: CHAR;
BEGIN
TextColor(StatusFg); TextBackGround(StatusBg);
IF Changed THEN
BEGIN
GotoXY(1,MaxLines);
Write(Chars(' ',(ScreenWidth-58) div 2),
'Descriptions have been edited. Shall they be saved (Y/N) ?');
ClrEol;
ch := ' ';
REPEAT
If KeyPressed Then ch := UpCase(ReadKey)
Else
If MouseLoaded Then
Begin
ButtonReleased(Left);
If ReleaseCount > 0 Then ch := 'Y';
ButtonReleased(Right);
If ReleaseCount > 0 Then ch := 'N';
End;
UNTIL (ch = 'Y') OR (ch = 'N');
Write(' ',ch);
IF ch = 'Y' THEN SaveDescriptions;
END;
END; (* QuerySaveDescriptions *)
PROCEDURE DirUp;
(* Go up one directory in the directory tree (if possible) *)
BEGIN
IF Changed THEN QuerySaveDescriptions;
{$I-}
ChDir('..');
{$I+}
IF IOResult = 0 THEN
BEGIN
ReadFiles;
RedrawScreen;
DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
Index := 0; UpdateLineNum(Index);
END;
END; (* DirUp *)
PROCEDURE DirDown;
(* Go down one directory in the directory tree (if possible) *)
BEGIN
IF (Index < FileList^.Count) THEN
BEGIN
n := ActFileData^.GetName;
IF (ActFileData^.GetSize = DirSize) AND (n[1] <> '.') THEN
BEGIN
IF Changed THEN QuerySaveDescriptions;
{$I-}
ChDir(n);
{$I+}
IF IOResult = 0 THEN
BEGIN
ReadFiles;
RedrawScreen;
END;
DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
Index := 0; UpdateLineNum(Index);
END; (* IF Description[Index].Size = DirSize *)
END;
END; (* DirDown *)
FUNCTION IsADelimiter(c: CHAR): BOOLEAN;
(* used by Ctrl-Left resp Ctrl-Right to recognize the end of a word *)
BEGIN
IsADelimiter := (Pos(c,DelimiterTable) > 0);
END;
BEGIN (* EditDescriptions *)
Index := 0; UpdateLineNum(Index);
Overwrite := FALSE; ResetCursor(Overwrite);
EditStr := ActFileData^.GetDesc;
REPEAT
REPEAT
Key := $0000;
IF KeyPressed THEN Key := GetKey
ELSE
BEGIN
IF MouseLoaded THEN
BEGIN
MouseMotion;
IF VMickey > VMickeysPerKeyPress THEN Key := kbDown
ELSE
IF VMickey < -VMickeysPerKeyPress THEN Key := kbUp
ELSE
IF HMickey > HMickeysPerKeyPress THEN Key := kbRight
ELSE
IF HMickey < -HMickeysPerKeyPress THEN Key := kbLeft
ELSE
BEGIN
ButtonReleased(Left);
IF ReleaseCount > 0 THEN Key := kbEnter;
ButtonReleased(Right);
IF ReleaseCount > 0 THEN Key := kbEsc;
END;
END; (* if mouseloaded *)
END;
UNTIL Key <> $0000;
CASE Key OF
kbUp : BEGIN
ActFileData^.AssignDesc(EditStr);
x := 1;
DisplayFileEntry(Index,x,FALSE); PrevIndex(Index);
END; (* Up *)
kbDown : BEGIN
ActFileData^.AssignDesc(EditStr);
x := 1;
DisplayFileEntry(Index,x,FALSE); NextIndex(Index);
END; (* Down *)
kbLeft : BEGIN
x := Max(1,x-1);
DisplayFileEntry(Index,x,TRUE);
END; (* Left *)
kbRight : BEGIN
x := Min(1+x,Length(EditStr));
DisplayFileEntry(Index,x,TRUE);
END; (* Right *)
kbCtrlLeft : BEGIN
DEC(x);
WHILE (x > 0) AND IsADelimiter(EditStr[x]) DO DEC(x);
WHILE (x > 0) AND NOT IsADelimiter(EditStr[x]) DO DEC(x);
INC(x);
DisplayFileEntry(Index,x,TRUE);
END; (* ^Left *)
kbCtrlRight: BEGIN
l := Length(EditStr);
WHILE (x < l) AND NOT IsADelimiter(EditStr[x]) DO INC(x);
WHILE (x < l) AND IsADelimiter(EditStr[x]) DO INC(x);
IF x = l THEN INC(x);
DisplayFileEntry(Index,x,TRUE);
END; (* ^Right *)
kbHome : BEGIN
x := 1; DisplayFileEntry(Index,x,TRUE);
END; (* Home *)
kbEnd : BEGIN
x := Min(Length(EditStr)+1,MaxDescLen);
DisplayFileEntry(Index,x,TRUE);
END; (* End *)
kbCtrlEnd : BEGIN
Delete(EditStr,x,MaxDescLen);
ActFileData^.AssignDesc(EditStr);
Changed := TRUE;
DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
DisplayFileEntry(Index,x,TRUE);
END; (* ^End *)
kbIns : BEGIN
Overwrite := NOT Overwrite;
ResetCursor(Overwrite);
END; (* Ins *)
kbDel : BEGIN
IF x <= Length(EditStr) THEN Delete(EditStr,x,1);
ActFileData^.AssignDesc(EditStr);
Changed := TRUE;
DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
DisplayFileEntry(Index,x,TRUE);
END; (* Del *)
kbBack : BEGIN
Delete(EditStr,x-1,1);
ActFileData^.AssignDesc(EditStr);
IF x > 1 THEN
BEGIN
DEC(x);
IF x > Length(EditStr) THEN x := Length(EditStr)+1;
END;
DisplayFileEntry(Index,x,TRUE);
Changed := TRUE;
DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
DisplayFileEntry(Index,x,TRUE);
END; (* Backspace *)
kbPgUp : BEGIN
ActFileData^.AssignDesc(EditStr);
x := 1;
DisplayFileEntry(Index,x,FALSE);
Index := Max(Index-ScreenSize,0);
StartIndex := Index;
RedrawScreen;
UpdateLineNum(Index);
END; (* PgUp *)
kbPgDn : BEGIN
ActFileData^.AssignDesc(EditStr);
Index := Min(Index+ScreenSize,FileList^.Count-1);
StartIndex := Max(Index-ScreenSize,0);
x := 1;
DisplayFileEntry(Index,x,FALSE);
RedrawScreen;
UpdateLineNum(Index);
END; (* PgDn *)
kbCtrlPgUp : BEGIN
ActFileData^.AssignDesc(EditStr);
x := 1;
DisplayFileEntry(Index,x,FALSE);
StartIndex := 0; Index := 0;
RedrawScreen;
UpdateLineNum(Index);
END; (* ^PgUp *)
kbCtrlPgDn : BEGIN
ActFileData^.AssignDesc(EditStr);
x := 1;
DisplayFileEntry(Index,x,FALSE);
StartIndex := Max(FileList^.Count-ScreenSize,0);
Index := FileList^.Count-1;
RedrawScreen;
UpdateLineNum(Index);
END; (* ^PgDn *)
kbAltD : BEGIN
ActFileData^.AssignDesc('');
Changed := TRUE;
DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
x := 1;
DisplayFileEntry(Index,x,FALSE);
NextIndex(Index);
END; (* Alt-D *)
kbAltM,
kbAltT : BEGIN
CutPasteDesc := ActFileData^.GetDesc;
ActFileData^.AssignDesc(''); EditStr := '';
Changed := TRUE;
DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
x := 1;
DisplayFileEntry(Index,x,FALSE);
NextIndex(Index);
END; (* Alt-M / Alt-T *)
kbAltC : BEGIN
CutPasteDesc := ActFileData^.GetDesc;
DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
x := 1;
DisplayFileEntry(Index,x,TRUE);
END; (* Alt-C *)
kbAltP : IF CutPasteDesc > '' THEN
BEGIN
ActFileData^.AssignDesc(CutPasteDesc);
x := 1;
DisplayFileEntry(Index,x,FALSE);
Changed := TRUE;
DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
NextIndex(Index);
END; (* Alt-P *)
kbEnter : BEGIN
ActFileData^.AssignDesc(EditStr);
x := 1;
DisplayFileEntry(Index,x,TRUE);
IF (Index < FileList^.Count) THEN
BEGIN
n := ActFileData^.GetName;
IF (ActFileData^.GetSize = DirSize) THEN
IF (n[1] = '.') AND (n[2] = '.') THEN DirUp
ELSE
IF n[1] <> '.' THEN DirDown;
END;
END; (* Enter = go into directory where the cursor is at *)
kbF1 : BEGIN (* F1: Help *)
ShowHelpPage;
ResetCursor(Overwrite);
DrawMainScreen(Index,FileList^.Count);
DrawDirLine;
RedrawScreen;
UpdateLineNum(Index);
END; (* F1 *)
kbF4 : DirDown; (* F4 *)
kbF5 : DirUp; (* F5 *)
kbAltL,
kbF6 : BEGIN (* F6: Change Drive *)
IF Changed THEN QuerySaveDescriptions;
ASM
mov ah,0eh (* Select Disk *)
mov dl,3
int 21h
add al,'@'
mov LastDrv,al
END;
IF LastDrv > 'Z' THEN LastDrv := 'Z';
TextColor(StatusFg); TextBackGround(StatusBg); Drv := ' :';
GotoXY(1,MaxLines);
Write(Chars(' ',((ScreenWidth-24) div 2)),
'New drive letter (A..',LastDrv,'): ');
ClrEol;
REPEAT
Drv[1] := UpCase(ReadKey);
UNTIL (Drv[1] >= 'A') AND (Drv[1] <= LastDrv);
IF Drv[1] <= 'B' THEN Drv := Drv + '\';
OldDir := ActDir;
{$I-}
ChDir(Drv);
{$I+}
IF IOResult = 0 THEN
BEGIN
GetDir(0,ActDir); IORes := IOResult;
ReadFiles;
IF FileList^.Count = 0 THEN
BEGIN
IF (Length(OldDir) > 3) AND (OldDir[Length(OldDir)] = '\') THEN
Delete(OldDir,Length(OldDir),1);
{$I-}
ChDir(OldDir); IORes := IOResult;
{$I+}
ReportError('There are no files on drive '+Drv+'. Press any key.',(CutPasteDesc <> ''),Changed);
ReadFiles;
END;
RedrawScreen;
DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);;
Index := 0;
UpdateLineNum(Index);
END
ELSE
ReportError('Drive '+Drv+' not ready! Drive remains unchanged, press a key.',(CutPasteDesc <> ''),Changed);
END; (* Alt-L or F6 *)
kbF10,
kbF2 : BEGIN (* F10: Save *)
SaveDescriptions;
UpdateLineNum(Index);
END; (* F10 or F2 *)
kbAltS,
kbShiftF10: BEGIN (* Shell to [4]DOS *)
IF Changed THEN QuerySaveDescriptions;
DoneMemory;
SetMemTop(HeapPtr);
NormVideo; ClrScr;
WriteLn('Type `Exit'' to return to 4DESC.');
SwapVectors;
Exec(GetEnv('COMSPEC'),'');
SwapVectors;
SetMemTop(HeapEnd);
InitMemory;
IF MouseLoaded THEN MouseReset;
ClrScr;
DrawMainScreen(Index,FileList^.Count);
DrawStatusLine(TRUE,(CutPasteDesc <> ''),Changed);
DrawDirLine;
IF DosError > 0 THEN
ReportError('Can''t load command interpreter / program execution failed.',
(CutPasteDesc <> ''),Changed);;
ReadFiles;
RedrawScreen;
UpdateLineNum(Index);
END; (* Alt-S or F10 *)
kbAltV,
kbF3 : IF (Index < FileList^.Count) THEN
BEGIN
IF ActFileData^.GetSize <> DirSize THEN
BEGIN (* F3: View File *)
FSplit(ActFileData^.GetName,NewDir,NewName,NewExt);
StripTrailingSpaces(NewName);
NewDir := ActDir; (* I do not want to loose actdir, newdir
is only a "dummy" variable. *)
IF (Length(NewDir) > 3) AND (NewDir[Length(NewDir)] = '\') THEN
Delete(NewDir,Length(NewDir),1);
DoneMemory;
SetMemTop(HeapPtr);
SwapVectors;
Exec(GetEnv('COMSPEC'),'/c '+ListCmd+' '+NewDir+'\'+NewName+NewExt);
SwapVectors;
SetMemTop(HeapEnd);
InitMemory;
IF MouseLoaded THEN MouseReset;
ClrScr;
DrawMainScreen(Index,FileList^.Count);
DrawStatusLine(TRUE,(CutPasteDesc <> ''),Changed);
DrawDirLine;
IF DosError > 0 THEN ReportError('Can''t load command interpreter/program execution failed.',
(CutPasteDesc <> ''),Changed);
RedrawScreen;
UpdateLineNum(Index);
END;
END; (* Alt-V or F3 *)
ELSE
IF (Ord(Key) > 31) AND (Ord(Key) < 256) THEN
BEGIN
IF NOT Changed THEN
BEGIN
Changed := TRUE;
DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
END;
IF x <= MaxDescLen THEN
BEGIN
IF Overwrite AND (x <= Length(EditStr)) THEN
EditStr[x] := Chr(Key)
ELSE
EditStr := Copy(EditStr,1,x-1)+Chr(Key)+Copy(EditStr,x,255);
ActFileData^.AssignDesc(EditStr);
INC(x);
END;
DisplayFileEntry(Index,x,TRUE);
END; (* all others *)
END; (* case *)
UNTIL (Key = kbEsc) OR (Key = kbAltX); (* ESC or AltX quits *)
IF Changed THEN QuerySaveDescriptions;
END; (* EditDescriptions *)
(*-------------------------------------------------------- Main *)
BEGIN
EdStart := 25+Length(DateFormat)+Length(TimeFormat);
DispLen := ScreenWidth-EdStart;
Str(DispLen,s); Template:= ' %-12s%s %s %s %-'+s+'s';
(* Template used by FormatDescription *)
{$I-}
GetDir(0,StartDir); IORes := IOResult; ShowHelp := FALSE;
{$I+}
IF ParamCount > 0 THEN
BEGIN
FOR i := 1 TO Min(2,ParamCount) DO
BEGIN
FirstParam := ParamStr(i);
IF (FirstParam[1] = '/') OR (FirstParam[1] = '-') THEN
BEGIN
IF NOT Monochrome THEN Monochrome := (UpCase(FirstParam[2]) = 'M');
IF NOT ShowHelp THEN ShowHelp := (UpCase(FirstParam[2]) = 'H') OR
(FirstParam[2] = '?');
END;
END; (* for ... do begin *)
NewDir := UpStr(ParamStr(ParamCount));
IF (NewDir[1] <> '/') AND (NewDir[1] <> '-') THEN
BEGIN
{$I-}
ChDir(NewDir); IORes := IOResult;
{$I+}
END;
END; (* if paramcount > 0 *)
Changed := FALSE; CutPasteDesc := '';
ChooseColors(Monochrome);
DrawMainScreen(0,0);
IF INIFileExists THEN
DelimiterTable := ReadSettingsString('misc','delimiters',DelimiterTable);
DelimiterTable := ' '+DelimiterTable;
IF ShowHelp THEN ShowHelpPage;
IF IORes > 0 THEN
ReportError(NewDir+' not found. Directory remains unchanged.',FALSE,FALSE);
InitMemory;
ReadFiles;
RedrawScreen;
EditDescriptions;
Dispose(FileList,Done); FileList := NIL;
DoneMemory;
{$I-}
ChDir(StartDir); IORes := IOResult;
{$I+}
IF MouseLoaded THEN MouseReset;
SetCursorShape(OrigCursor);
NormVideo;
ClrScr;
WriteLn(Header);
WriteLn;
WriteLn('This program is freeware: you are allowed to use, copy it free');
WriteLn('of charge, but you may not sell or hire 4DESC.');
END.