Category : Modula II Source Code
Archive   : FILETOO2.ZIP
Filename : FILETOOL.MOD
(*
Title : FILETOOL.MOD
LastEdit : 12/31/87
Author : Russell G. Osterlund, Jr.
System : LOGITECH MODULA-2/86, REPERTOIRE, BlackBeard
This product has been developed with the use of, and embodies portions of,
LOGITECH software development tools - compiler, linker, LOD2EXE, and MAKE.
*)
FROM SYSTEM IMPORT
ADR;
FROM EnvironUtils IMPORT (* REPERTOIRE *)
ParsedParam;
FROM WindowPrims IMPORT (* REPERTOIRE *)
PushColors, PopColors;
FROM SmartScreen IMPORT (* REPERTOIRE *)
ClearScreen, SetCursorHeight, TextColor,
ForeGround, BackGround;
FROM GetKey IMPORT (* REPERTOIRE *)
CRchar, TABchar, SPCchar, BTBnum,
LARWnum, RARWnum, UARWnum, DARWnum,
HOMnum, ENDnum, PGUPnum, PGDNnum,
KeySet,
MakeKeySet, ConcatKeySets, GetKey;
FROM Strings IMPORT
Assign;
FROM StringIO IMPORT (* REPERTOIRE *)
ErrorMessage;
FROM Drectory IMPORT (* REPERTOIRE *)
GetCurrentDir, GetDefaultDrive, SetDefaultDrive, ChDir;
FROM ToolDisplay IMPORT
DisplayInfo,
MainMenu, MainMenuPos, DisplayMainMenu,
DECMenuPos, INCMenuPos, ClearMessage;
FROM ToolUtilities IMPORT
InitDirectoryInfo, ReadInfo;
FROM ToolCommands IMPORT
UpOneFile, DownOneFile, UpOnePage, DownOnePage,
TopOfPage, BottomOfPage, BeginningOfList, EndOfList,
MoveUpOneLevel, MoveDownOneLevel, ActivateNewWindow,
TagCurrentFile;
FROM ToolMenuCommands IMPORT
HelpCommand, CopyCommand, MoveCommand, DeleteCommand,
SortCommand, AttributesCommand, OtherCommand,
EditListCommand, RenameCommand, ExecuteCommand;
FROM ToolTypes IMPORT
WindowType, ActiveWindow, BothWindowsActive, DirectoryInfo;
CONST
VersionLevel = '1.03';
VAR
Done,
ExtendedKey: BOOLEAN;
Key: CHAR;
MainMenuKeySet: KeySet;
error: ErrorMessage;
OriginalDrive: CHAR;
OriginalPath: ARRAY [0 .. 65] OF CHAR;
PROCEDURE Initialize;
VAR
MainMenuKeySet1,
MainMenuKeySet2,
MainMenuKeySet3: KeySet;
BEGIN
Done := FALSE;
ClearScreen ();
MakeKeySet (' "q";"Q";"h";"H";"c";"C";"m";"M";"d";"D";"e";"E";"l";"L";"r";"R";"x";"X";"s";"S";"a";"A";"o";"O" ',
MainMenuKeySet1);
MakeKeySet (' "<";">";E117;E119 ',
MainMenuKeySet2);
MakeKeySet (' 13;9;" ";E15;E75;E77;E72;E80;E71;E79;E73;E81 ',
MainMenuKeySet3);
ConcatKeySets (MainMenuKeySet1, MainMenuKeySet2, MainMenuKeySet1);
ConcatKeySets (MainMenuKeySet1, MainMenuKeySet3, MainMenuKeySet);
InitDirectoryInfo (ADR (DirectoryInfo [0]));
ActiveWindow := LeftWindow;
BothWindowsActive := FALSE;
OriginalDrive := GetDefaultDrive ();
error := GetCurrentDir (OriginalDrive, OriginalPath);
Assign (OriginalPath, DirectoryInfo [ORD (LeftWindow)] . DirectoryPath);
IF ParsedParam (1, DirectoryInfo [ORD (LeftWindow)] . DirectoryMask) THEN
ELSE
DirectoryInfo [ORD (LeftWindow)] . DirectoryMask := '*.*';
END;
ReadInfo (ADR (DirectoryInfo [ORD (LeftWindow)]));
DisplayMainMenu ();
DisplayInfo (ADR (DirectoryInfo [ORD (LeftWindow)]), 0, TRUE);
END Initialize;
BEGIN
SetCursorHeight (0);
PushColors ();
Initialize ();
REPEAT
GetKey (MainMenuKeySet, Key, ExtendedKey);
ClearMessage ();
IF ExtendedKey THEN
CASE ORD (Key) OF
BTBnum: (* shift-tab *)
DECMenuPos (HIGH (MainMenu), MainMenuPos);
DisplayMainMenu ();
| LARWnum: (* left arrow *)
ActivateNewWindow (LeftWindow,
ADR (DirectoryInfo [0]),
ADR (DirectoryInfo [1]));
| RARWnum: (* right arrow *)
ActivateNewWindow (RightWindow,
ADR (DirectoryInfo [0]),
ADR (DirectoryInfo [1]));
| UARWnum: (* up arrow *)
UpOneFile (ADR (DirectoryInfo [ORD (ActiveWindow)]));
| DARWnum: (* down arrow *)
DownOneFile (ADR (DirectoryInfo [ORD (ActiveWindow)]));
| HOMnum: (* home *)
TopOfPage (ADR (DirectoryInfo [ORD (ActiveWindow)]));
| ENDnum: (* end *)
BottomOfPage (ADR (DirectoryInfo [ORD (ActiveWindow)]));
| PGUPnum: (* page up *)
UpOnePage (ADR (DirectoryInfo [ORD (ActiveWindow)]));
| PGDNnum: (* page down *)
DownOnePage (ADR (DirectoryInfo [ORD (ActiveWindow)]));
| 117: (* ctrl-end *)
EndOfList (ADR (DirectoryInfo [ORD (ActiveWindow)]));
| 119: (* ctrl-home *)
BeginningOfList (ADR (DirectoryInfo [ORD (ActiveWindow)]));
ELSE
END;
ELSE
IF Key = CRchar THEN
Key := MainMenu [MainMenuPos] . KeyEquivalent;
END;
CASE Key OF
"q", "Q": (* quit *)
Done := TRUE;
| "h", "H": (* help *)
MainMenuPos := 4;
HelpCommand (ADR (DirectoryInfo [0]), ADR (DirectoryInfo [1]));
DisplayMainMenu ();
| "c", "C": (* copy *)
MainMenuPos := 1;
CopyCommand (ADR (DirectoryInfo [ORD (ActiveWindow)]));
DisplayMainMenu ();
| "m", "M": (* move *)
MainMenuPos := 6;
MoveCommand (ADR (DirectoryInfo [ORD (ActiveWindow)]));
DisplayMainMenu ();
| "d", "D": (* delete *)
MainMenuPos := 2;
DeleteCommand (ADR (DirectoryInfo [ORD (ActiveWindow)]));
DisplayMainMenu ();
| "e", "E": (* edit *)
MainMenuPos := 3;
EditListCommand (ADR (DirectoryInfo [0]), ADR (DirectoryInfo [1]), TRUE);
DisplayMainMenu ();
| "l", "L": (* list *)
MainMenuPos := 5;
EditListCommand (ADR (DirectoryInfo [0]), ADR (DirectoryInfo [1]), FALSE);
DisplayMainMenu ();
| "r", "R": (* rename *)
MainMenuPos := 9;
RenameCommand (ADR (DirectoryInfo [ORD (ActiveWindow)]));
DisplayMainMenu ();
| "x", "X": (* execute *)
MainMenuPos := 11;
ExecuteCommand (ADR (DirectoryInfo [0]), ADR (DirectoryInfo [1]));
DisplayMainMenu ();
| "s", "S": (* sort *)
MainMenuPos := 10;
SortCommand ();
DisplayMainMenu ();
| "a", "A": (* attributes *)
MainMenuPos := 0;
AttributesCommand (ADR (DirectoryInfo [ORD (ActiveWindow)]));
DisplayMainMenu ();
| "o", "O": (* other *)
MainMenuPos := 7;
OtherCommand (ADR (DirectoryInfo [0]), ADR (DirectoryInfo [1]));
DisplayMainMenu ();
| "<": (* up one level *)
MoveUpOneLevel (ADR (DirectoryInfo [ORD (ActiveWindow)]));
| ">": (* down one level *)
MoveDownOneLevel (ADR (DirectoryInfo [ORD (ActiveWindow)]));
| TABchar: (* tab *)
INCMenuPos (HIGH (MainMenu), MainMenuPos);
DisplayMainMenu ();
| SPCchar: (* space *)
TagCurrentFile (ADR (DirectoryInfo [ORD (ActiveWindow)]));
ELSE
END;
END;
UNTIL Done;
SetDefaultDrive (OriginalDrive);
error := ChDir (OriginalPath);
PopColors ();
TextColor (ForeGround, BackGround);
ClearScreen ();
SetCursorHeight (2);
END FileTool.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/