
{*******************************************************}
{                                                       }
{       Turbo Pascal Version 7.0                        }
{       Turbo Vision Unit                               }
{                                                       }
{       Copyright (c) 1992 Borland International        }
{                                                       }
{       Virtual Pascal v2.1                             }
{       Copyright (C) 1996-2000 vpascal.com             }
{                                                       }
{*******************************************************}

unit HistList;

{$X+,I-,S-,Cdecl-,Use32+}

{****************************************************************************
   History buffer structure:

     Longint  String        StrLen Longint String        StrLen
    +----------------------------+----------------------------+--...--+
    |  Id   | History string | L |  Id   | History string | L |
    +----------------------------+----------------------------+--...--+

 ***************************************************************************}

interface

uses Objects;

const
  HistoryBlock: Pointer = nil;
  HistorySize: Word = 2*1024;
  HistoryUsed: Word = 0;

procedure HistoryAdd(Id: Longint; const Str: String);
function HistoryCount(Id: Longint): Word;
function HistoryStr(Id: Longint; Index: Integer): String;
procedure ClearHistory;

procedure InitHistory;
procedure DoneHistory;

procedure StoreHistory(var S: TStream);
procedure LoadHistory(var S: TStream);

implementation

var
  CurId: Longint;
  CurString: PString;

{ Advance CurString to next string with an ID of CurId }

procedure AdvanceStringPointer; assembler; {$USES esi} {$FRAME-}
asm
                mov     ecx,HistoryUsed
                mov     edx,CurId
                mov     esi,CurString
                test    esi,esi
                jz      @@4
                cld
                cmp     esi,HistoryBlock
                jne     @@2
                cmp     esi,ecx
                je      @@3
              @@1:
                lodsd                   { History Id  }
                cmp     eax,edx         { edx = CurId }
                je      @@4
              @@2:
                movzx   eax,Byte Ptr [esi]
                lea     esi,[esi+eax+2]
                cmp     esi,ecx         { ecx = HistoryUsed }
                jb      @@1
              @@3:
                xor     esi,esi
              @@4:
                mov     CurString,esi
end;

{ Deletes the current string from the table }

procedure DeleteString; assembler; {$USES esi,edi} {$FRAME-}
asm
                cld
                mov     ecx,HistoryUsed
                mov     esi,CurString
                lea     edi,[esi-TYPE Longint]
                movzx   eax,Byte Ptr [esi]
                lea     esi,[esi+eax+2]
                sub     ecx,esi
                rep     movsb
                mov     HistoryUsed,edi
end;

{ Insert a string into the table }

procedure InsertString(Id: Longint; const Str: String); assembler; {$USES ebx,esi,edi} {$FRAME-}
asm
{ Position edi to the end the buffer  }
{          edx to beginning of buffer }
                mov     edx,HistoryBlock
                mov     edi,HistoryUsed
                mov     esi,Str
                movzx   ebx,Byte Ptr [esi]
                add     ebx,TYPE Longint + TYPE Byte + TYPE Byte
              @@1:
                mov     eax,edi
                add     eax,ebx
                sub     eax,edx         { edx = HistoryBlock }
                cmp     eax,HistorySize
                jb      @@2
{ Drop the last string off the end of the list }
                movzx   eax,Byte Ptr [edi-1] { Last string length }
                sub     edi,eax
                sub     edi,TYPE Longint + TYPE Byte + TYPE Byte
                jmp     @@1
{ Move the table down the size of the string }
              @@2:
                std
                mov     esi,edi
                add     edi,ebx
                mov     HistoryUsed,edi
                mov     ecx,esi
                sub     ecx,edx         { edx = HistoryBlock }
                dec     esi
                dec     edi
                rep     movsb
{ Copy the string into the position }
                cld
                mov     edi,edx         { edx = HistoryBlock }
                mov     eax,Id
                stosd                   { Id     }
                mov     esi,Str
                xor     eax,eax
                lodsb
                stosb                   { StrLen }
                mov     ecx,eax
                rep     movsb           { String }
                stosb                   { StrLen }
end;

procedure StartId(Id: Longint);
begin
  CurId := Id;
  CurString := HistoryBlock;
end;

function HistoryCount(Id: Longint): Word;
var
  Count: Word;
begin
  StartId(Id);
  Count := 0;
  AdvanceStringPointer;
  while CurString <> nil do
  begin
    Inc(Count);
    AdvanceStringPointer;
  end;
  HistoryCount := Count;
end;

procedure HistoryAdd(Id: Longint; const Str: String);
begin
  if Str = '' then Exit;

  StartId(Id);

  { Delete duplicates }
  AdvanceStringPointer;
  while CurString <> nil do
  begin
    if Str = CurString^ then DeleteString;
    AdvanceStringPointer;
  end;

  InsertString(Id, Str);
end;

function HistoryStr(Id: Longint; Index: Integer): String;
var
  I: Integer;
begin
  StartId(Id);
  for I := 0 to Index do AdvanceStringPointer;
  if CurString <> nil then
    HistoryStr := CurString^ else
    HistoryStr := '';
end;

procedure ClearHistory;
begin
  HistoryUsed := Longint(HistoryBlock);
end;

procedure StoreHistory(var S: TStream);
var
  Size: Word;
begin
  Size := HistoryUsed - Longint(HistoryBlock);
  S.Write(Size, SizeOf(Word));
  S.Write(HistoryBlock^, Size);
end;

procedure LoadHistory(var S: TStream);
var
  Size: Word;
begin
  S.Read(Size, SizeOf(Word));
  S.Read(HistoryBlock^, Size);
  HistoryUsed := Longint(HistoryBlock) + Size;
end;

procedure InitHistory;
begin
  GetMem(HistoryBlock, HistorySize);
  ClearHistory;
end;

procedure DoneHistory;
begin
  FreeMem(HistoryBlock, HistorySize);
end;

end.
