Category : Miscellaneous Language Source Code
Archive   : E!518.ZIP
Filename : P!.PAS

 
Output of file : P!.PAS contained in archive : E!518.ZIP

{/////////////////////////////////////////////////////////////////////////////}
{ P! - Main source file }
{/////////////////////////////////////////////////////////////////////////////}
{ This is a partial source file for P!.EXE. P! uses copyrighted material that }
{ may not be distributed. Sorry. We release this file only to show you how to }
{ use the E! API to register commands and to store your data on the heap main-}
{ tained by E!. }
{/////////////////////////////////////////////////////////////////////////////}

Program p;
{$IFDEF DEBUG}
{$A-,B-,D+,F+,I-,N-,R-,S-,V-,L+,O-}
{$ELSE}
{$A-,B-,D-,F+,I-,N-,R-,S-,V-,L-,O-}
{$ENDIF}

USES
DOS,
TYPES, { This is a proprietary unit }
TPSTRING, { These units are from the Turbo Professional }
TPCRT, { Toolbox from TurboPower, distributed in }
TPWINDOW, { France by ATEA. }
TPPICK, {}
TPDIR, {}
TPEDIT, {}
TPDOS, {}
API,
KEYBOARD; { This is a proprietary unit }

TYPE

pathptr = ^pathstr;

logrecord = RECORD
filename : pathstr; { FileName }
dummy : array [1..46] of byte;
lastloadflag : boolean;
{ other status information is not required here }
END;
{ structure information of the E!.LOG files - partial }

CONST

GLOBALMASK = '*.*'; { default path string }
PID = 2604; { P! handle identification for memory reservation }
{ author's birthdate ! }
ColorAttrs : PickColorArray = ($1B, $17, $30, $7E, $1E, $7E);
MonoAttrs : PickColorArray = ($07, $07, $0F, $7F, $0F, $70);
MAXLOGFILES = 10; { Number of files registered in a log file }
{$IFDEF US}
Names : commandline = 'Edit ';
{$ELSE}
Names : commandline = 'Edite ';
{$ENDIF}

VAR

MaskPtr : pointer; { Pointer to user path }
SaveMask,
Fname : PathStr; { Name of file to edit }
savename : string[12];
WinPtr : windowptr;
Escaped : boolean;
retcode : word;
IntStr : string[3]; { Interrupt number used by E! }
IntNum : byte; { " " " " " }
valretcode : integer;
XY,
scanlines : word;
FirstTime : boolean; { First pass flag }
LogArray : array [1..MAXLOGFILES] of pathstr;
Choice : word;
FileNum,
MaxFileLength : integer;
color : PickColorArray;
Status : statusrecord;
AttrPtr : ^attrrecord;
NamePos : byte;
CurrentDir : pathstr;
message : string[80];
wattr,
fattr,
hattr : byte;
dummyptr : pointer;

LABEL

Prompt, Terminate;


Procedure PromptWindow;
{ Ask user for a path name }

procedure haltprompt;
begin
RestoreCursorState(XY, scanlines);
Halt;
end;

BEGIN
IF MakeWindow(WinPtr, 4, 12, 76, 14,
{$IFDEF US}
true, true, true, wattr, fattr, hattr, 'Enter a filename mask')
{$ELSE}
true, true, true, wattr, fattr, hattr, 'Entrez un masque de recherche')
{$ENDIF}
THEN BEGIN
IF DisplayWindow(WinPtr)
THEN BEGIN
ReadString('', 13, 5, 70, wattr, fattr-1, wattr, Escaped, PathPtr(MaskPtr)^);
DisposeWindow(EraseTopWindow);
END;
IF Escaped THEN HaltPrompt;
END
ELSE HaltPrompt;
END;

Procedure PopUpError(errorlevel : byte);
{ Display error if any }

CONST

{$IFDEF US}
ErrorArray : array[1..8] of string[20] =
('Path not found.',
'No matching file.',
'New file.',
'Not enough memory.',
'DOS error.',
'E! is not present !',
'Bad interrupt number',
'E! is not idle');
{$ELSE}
ErrorArray : array[1..8] of string[39] =
('Chemin non trouv‚.',
'Pas de fichier correspondant au masque.',
'Nouveau fichier.',
'Pas assez de m‚moire. D‚sol‚.',
'Erreur DOS.',
'E! n''est pas pr‚sent en m‚moire!',
'No d''interruption invalide.',
'E! n''est pas inactif');
{$ENDIF}

VAR
PopWinPtr : WindowPtr;

BEGIN
IF MakeWindow(PopWinPtr, 20, 12,
Length(ErrorArray[errorlevel]) + 21,
{$IFDEF US}
14, true, true, true, $17, $1E, $1F, 'Error!')
{$ELSE}
14, true, true, true, $17, $1E, $1F, 'Erreur!')
{$ENDIF}
and DisplayWindow(PopWinPtr)
THEN BEGIN
FastWriteWindow(ErrorArray[errorlevel], 1, 1, $1E);
WHILE not Keypressed DO;
DisposeWindow(EraseTopWindow);
ClearKbd;
END;
RestoreCursorState(XY, scanlines);
IF ErrorLevel < 4 THEN PromptWindow;
END;

Procedure LoadLogFile;
{ Retrieve filenames from the E! log file }

VAR index : byte;
logfile : file of logrecord;
log : logrecord;

BEGIN
Assign(logfile,'E!.LOG');
Reset(logfile);
FileNum:=0;
FOR index:=1 TO MAXLOGFILES DO
BEGIN
Read(logfile, log);
IF log.lastloadflag
THEN BEGIN
Logarray[Succ(FileNum)]:=log.filename;
Inc(FileNum);
END;
END;
Close(logfile);
MaxFileLength:=6; { 'E!.LOG' string }
{ Compute the pick window width }
FOR index:=1 TO FileNum DO
IF Length(LogArray[index]) > MaxFileLength
THEN MaxFileLength:=Length(LogArray[index]);
END;

{$F+}
Function GiveLogNames(item:word):pathstr;
{ Required to feed the PickWindow function }

BEGIN
GiveLogNames:=LogArray[item];
END;
{$F-}

Procedure Pop_and_Clear(code:byte);

BEGIN
PopupError(code);
ClearKbd;
END;

BEGIN
GetCursorState(XY, scanlines);
HiddenCursor;
IF StUpcase(ParamStr(1)) = '/M'
THEN BEGIN
color:=MonoAttrs;
wattr:=$07;
fattr:=$07;
hattr:=$07;
END
ELSE BEGIN
color:=ColorAttrs;
wattr:=$37;
fattr:=$31;
hattr:=$34;
END;

IntStr:=GetEnv('E!PRESENT');
{ Get the E! API interrupt number }
IF IntStr = ''
THEN BEGIN
PopUpError(6);
Halt;
END;
Val(IntStr, IntNum, valretcode);
{ Convert it to a byte }
IF valretcode <> 0
THEN BEGIN
PopUpError(7);
Halt;
END
ELSE E_Vec:=IntNum;

IF not Is_E_Idle THEN BEGIN PopUpError(8); Halt; END;

dummyptr:=Request_E_Address(SCR_REQUEST);
VirtualSegment:=Seg(dummyptr^);
VideoSegment:=VirtualSegment;

{ The following call is made each time the program is loaded. Once for }
{ memory allocation and then to retrieve the memory block address which }
{ has likely changed and that our P! program has forgotten anyway. }

IF not Get_E_Memory(5, PID, MaskPtr, FirstTime)
THEN BEGIN
{ Memory allocation on E! heap failed so we do it on OUR heap }
GetMem(PathPtr(MaskPtr), 80);
PathPtr(MaskPtr)^:=GLOBALMASK;
END
ELSE IF FirstTime { First pass : string initialization }
THEN PathPtr(MaskPtr)^:=GLOBALMASK;
{ ELSE the user has initialized the string }

IF NOT MultitaskingOn THEN EnablePickMouse;
PickSrch:=StringPickSrch;
Get_E_Status(status);
AttrPtr:=Request_E_Address(ATTR_REQUEST);

IF ExistFile('E!.LOG') { First P! displays the content of the log file }
THEN BEGIN { if any is present }
LoadLogFile;
Choice:=1;
IF (IOResult <> 0)
or (NOT PickWindow(@GiveLogNames,
FileNum,
3, 5, MaxFileLength + 4, 7 + FileNum,
True,
color,
'E!.LOG',
Choice)
or (PickCmdNum = PKSExit))
THEN Goto Prompt { Display directory }
ELSE IF PickCmdNum = PKSSelect
THEN BEGIN
RegisterCommand(Names + LogArray[Choice]);
PathPtr(MaskPtr)^:=JustPathName(LogArray[Choice]);
Goto Terminate;
END;
END;

Prompt:

ReturnCompletePath:=True;
PromptWindow;
SaveMask:=PathPtr(MaskPtr)^;
GetDir(0, CurrentDir);
ShowDrives:=true;

REPEAT
savename:=JustFileName(PathPtr(MaskPtr)^);
retcode:=GetFileName(PathPtr(MaskPtr)^,
$30, 9, 3,
Status.lower - 3, 5,
color,
Fname);
CASE retcode OF
0 : BEGIN
{ A filename has been selected so we tell E! to edit it on return }
IF CurrentDir = JustPathName(FName)
THEN FName:=JustFileName(FName);
{ We selected the current directory, no need to store pathname }
NamePos:=Pos(FName, Names);
IF NOT (NamePos IN [0..1])
{ This is because of a quirk in TP function Pos() returning 1 }
{ when the object string is null }
THEN Delete(Names, NamePos, Succ(Length(FName)))
ELSE IF Length(FName) + Length(Names) <= Pred(SizeOf(Names)) - 6 {Length of 'EDITE '}
THEN Names:=Names + FName + ' ';
{$IFDEF US}
IF Trim(Names) <> 'Edit'
{$ELSE}
IF Trim(Names) <> 'Edite'
{$ENDIF}
THEN message:=Names
ELSE message:='';
FastWrite(Pad(message, Pred(SizeOf(commandstring))),
Pred(Status.Lower),
1,
AttrPtr^.CommandLineAttr);
{ Last selected directory is saved for the next call to P! }
IF FName <> ''
THEN BEGIN
PathPtr(MaskPtr)^:=JustPathName(FExpand(FName));
IF PathPtr(MaskPtr)^[Length(PathPtr(MaskPtr)^)] <> '\'
THEN PathPtr(MaskPtr)^:=PathPtr(MaskPtr)^ + '\';
PathPtr(MaskPtr)^:=PathPtr(MaskPtr)^ + savename;
END;
END;
1,2 : Pop_and_Clear(retcode);
3,4 : PopupError(retcode);
ELSE
PopupError(5);
END;
IF PathPtr(MaskPtr)^ = ''
THEN PathPtr(MaskPtr)^:=SaveMask;
{ If no file was selected save the previous path for the next call }

UNTIL (FName = '') and (retcode = 0);
{$IFDEF US}
IF Trim(Names) <> 'Edit'
{$ELSE}
IF Trim(Names) <> 'Edite'
{$ENDIF}
THEN RegisterCommand(Names);
{ The "Edit" command and the name of the files to be edited are now stored }
{ in Names which is passed back to E! to be executed as a command. }

terminate:
RestoreCursorState(XY, scanlines);
IF NOT MultitaskingOn THEN DisablePickMouse;
END.