freepascal.compiler/fv/histlist.pas

{ $Id$ }
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
{                                                          }
{   System independent GRAPHICAL clone of HISTLIST.PAS     }
{                                                          }
{   Interface Copyright (c) 1992 Borland International     }
{                                                          }
{   Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer   }
{   [email protected]  - primary e-mail address        }
{   [email protected] - backup e-mail address         }
{                                                          }
{****************[ THIS CODE IS FREEWARE ]*****************}
{                                                          }
{     This sourcecode is released for the purpose to       }
{   promote the pascal language on all platforms. You may  }
{   redistribute it and/or modify with the following       }
{   DISCLAIMER.                                            }
{                                                          }
{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
{                                                          }
{*****************[ SUPPORTED PLATFORMS ]******************}
{     16 and 32 Bit compilers                              }
{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
{                 - Delphi 1.0+             (16 Bit)       }
{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
{                 - Virtual Pascal 2.0+     (32 Bit)       }
{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
{                 - FPC 0.9912+             (32 Bit)       }
{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
{                                                          }
{******************[ REVISION HISTORY ]********************}
{  Version  Date        Fix                                }
{  -------  ---------   ---------------------------------  }
{  1.00     11 Nov 96   First DOS/DPMI platform release.   }
{  1.10     13 Jul 97   Windows platform code added.       }
{  1.20     29 Aug 97   Platform.inc sort added.           }
{  1.30     13 Oct 97   Delphi 2 32 bit code added.        }
{  1.40     05 May 98   Virtual pascal 2.0 code added.     }
{  1.50     30 Sep 99   Complete recheck preformed         }
{  1.51     03 Nov 99   FPC windows support added          }
{**********************************************************}

UNIT HistList;

{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                                  INTERFACE
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

{====Include file to sort compiler platform out =====================}
{$I Platform.inc}
{====================================================================}

{==== Compiler directives ===========================================}

{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
  {$F-} { Short calls are okay }
  {$A+} { Word Align Data }
  {$B-} { Allow short circuit boolean evaluations }
  {$O+} { This unit may be overlaid }
  {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
  {$P-} { Normal string variables }
  {$N-} { No 80x87 code generation }
  {$E+} { Emulation is on }
{$ENDIF}

{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$S-} { Disable Stack Checking }
{$I-} { Disable IO Checking }
{$Q-} { Disable Overflow Checking }
{$V-} { Turn off strict VAR strings }
{====================================================================}

USES FVCommon, Objects;                                 { Standard GFV units }

{***************************************************************************}
{                            INTERFACE ROUTINES                             }
{***************************************************************************}

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                     HISTORY SYSTEM CONTROL ROUTINES                       }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-InitHistory--------------------------------------------------------
Initializes the history system usually called from Application.Init
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE InitHistory;

{-DoneHistory--------------------------------------------------------
Destroys the history system usually called from Application.Done
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE DoneHistory;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                          HISTORY ITEM ROUTINES                            }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-HistoryCount-------------------------------------------------------
Returns the number of strings in the history list with ID number Id.
30Sep99 LdB
---------------------------------------------------------------------}
FUNCTION HistoryCount (Id: Byte): Word;

{-HistoryStr---------------------------------------------------------
Returns the Index'th string in the history list with ID number Id.
30Sep99 LdB
---------------------------------------------------------------------}
FUNCTION HistoryStr (Id: Byte; Index: Sw_Integer): String;

{-ClearHistory-------------------------------------------------------
Removes all strings from all history lists.
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE ClearHistory;

{-HistoryAdd---------------------------------------------------------
Adds the string Str to the history list indicated by Id.
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE HistoryAdd (Id: Byte; Const Str: String);

function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-LoadHistory--------------------------------------------------------
Reads the application's history block from the stream S by reading the
size of the block, then the block itself. Sets HistoryUsed to the end
of the block read. Use LoadHistory to restore a history block saved
with StoreHistory
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE LoadHistory (Var S: TStream);

{-StoreHistory--------------------------------------------------------
Writes the currently used portion of the history block to the stream
S, first writing the length of the block then the block itself. Use
the LoadHistory procedure to restore the history block.
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE StoreHistory (Var S: TStream);

{***************************************************************************}
{                        INITIALIZED PUBLIC VARIABLES                       }
{***************************************************************************}
{---------------------------------------------------------------------------}
{                 INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                 }
{---------------------------------------------------------------------------}
CONST
   HistorySize: Word = 64*1024;                       { Maximum history size }
   HistoryUsed: LongInt = 0;                          { History used }
   HistoryBlock: Pointer = Nil;                       { Storage block }

{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                                IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

{***************************************************************************}
{                      PRIVATE RECORD DEFINITIONS                           }
{***************************************************************************}

{---------------------------------------------------------------------------}
{                       THistRec RECORD DEFINITION                          }
{---------------------------------------------------------------------------}
TYPE
   THistRec =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
   PACKED
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
   RECORD
     Zero: byte;                                      { Start marker }
     Id  : byte;                                      { History id }
     Str : String;                                    { History string }
   END;
   PHistRec = ^THistRec;                              { History record ptr }

{***************************************************************************}
{                      UNINITIALIZED PRIVATE VARIABLES                      }
{***************************************************************************}
{---------------------------------------------------------------------------}
{                UNINITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                }
{---------------------------------------------------------------------------}
VAR
   CurId: Byte;                                       { Current history id }
   CurString: PString;                                { Current string }

{***************************************************************************}
{                          PRIVATE UNIT ROUTINES                            }
{***************************************************************************}

{---------------------------------------------------------------------------}
{  StartId -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE StartId (Id: Byte);
BEGIN
   CurId := Id;                                       { Set current id }
   CurString := HistoryBlock;                         { Set current string }
END;

{---------------------------------------------------------------------------}
{  DeleteString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
{---------------------------------------------------------------------------}
PROCEDURE DeleteString;
VAR Len: Sw_Integer; P, P2: PChar;
BEGIN
   P := PChar(CurString);                             { Current string }
   P2 := PChar(CurString);                            { Current string }
   Len := PByte(P2)^+3;                               { Length of data }
   Dec(P, 2);                                         { Correct position }
   Inc(P2, PByte(P2)^+1);                             { Next hist record }
   { Shuffle history }
   Move(P2^, P^, cardinal(HistoryBlock) + HistoryUsed - cardinal(P2) );
   Dec(HistoryUsed, Len);                             { Adjust history used }
END;

{---------------------------------------------------------------------------}
{  AdvanceStringPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB  }
{---------------------------------------------------------------------------}
PROCEDURE AdvanceStringPtr;
VAR P: PHistRec;
BEGIN
   While (CurString <> Nil) Do Begin
     If (cardinal(CurString) >= cardinal(HistoryBlock) + HistoryUsed) Then Begin{ Last string check }
       CurString := Nil;                              { Clear current string }
       Exit;                                          { Now exit }
     End;
     Inc(PChar(CurString), PByte(CurString)^+1);      { Move to next string }
     If (cardinal(CurString) >= cardinal(HistoryBlock) + HistoryUsed) Then Begin{ Last string check }
       CurString := Nil;                              { Clear current string }
       Exit;                                          { Now exit }
     End;
     P := PHistRec(CurString);                        { Transfer record ptr }
     Inc(PChar(CurString), 2);                        { Move to string }
     if (P^.Zero<>0) then
       RunError(215);
     If (P^.Id = CurId) Then Exit;                    { Found the string }
   End;
END;

{---------------------------------------------------------------------------}
{  InsertString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
{---------------------------------------------------------------------------}
PROCEDURE InsertString (Id: Byte; Const Str: String);
VAR P1, P2: PChar;
    P : PHistRec;
BEGIN
  while (HistoryUsed+Length(Str)+3>HistorySize) do
   begin
       P:=PHistRec(HistoryBlock);
       while Pointer(P)<Pointer(HistoryBlock)+HistorySize do
         begin
           if Pointer(P)+Length(P^.Str)+6+Length(Str) >
              Pointer(HistoryBlock)+HistorySize then
             begin
               HistoryUsed:=HistoryUsed-(Length(P^.Str)+3);
               FillChar(P^,Pointer(HistoryBlock)+HistorySize-Pointer(P),#0);
               break;
             end;
           P:=PHistRec(Pointer(P)+Length(P^.Str)+3);
         end;
   end;
   P1 := PChar(HistoryBlock)+1;                     { First history record }
   P2 := P1+Length(Str)+3;                          { History record after }
   Move(P1^, P2^, HistoryUsed - 1);                 { Shuffle history data }
   PHistRec(P1)^.Zero := 0;                         { Set marker byte }
   PHistRec(P1)^.Id := Id;                          { Set history id }
   {$IFDEF PPC_DELPHI3}                             { DELPHI3+ COMPILER }
   Move(Str[1], PHistRec(P1)^.Str[1], Length(Str)); { Set history string }
   SetLength(PHistRec(P1)^.Str, Length(Str));       { Set string length }
   {$ELSE}                                          { OTHER COMPILERS }
   Move(Str[0], PHistRec(P1)^.Str, Length(Str)+1);  { Set history string }
   {$ENDIF}
   Inc(HistoryUsed, Length(Str)+3);                 { Inc history used }
END;

{***************************************************************************}
{                            INTERFACE ROUTINES                             }
{***************************************************************************}

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                     HISTORY SYSTEM CONTROL ROUTINES                       }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  InitHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE InitHistory;
BEGIN
   GetMem(HistoryBlock, HistorySize);                 { Allocate block }
   ClearHistory;                                      { Clear the history }
END;

{---------------------------------------------------------------------------}
{  DoneHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE DoneHistory;
BEGIN
   If (HistoryBlock <> Nil) Then                      { History block valid }
     FreeMem(HistoryBlock, HistorySize);              { Release history block }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                          HISTORY ITEM ROUTINES                            }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  HistoryCount -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
{---------------------------------------------------------------------------}
FUNCTION HistoryCount(Id: Byte): Word;
VAR Count: Word;
BEGIN
   StartId(Id);                                       { Set to first record }
   Count := 0;                                        { Clear count }
   If (HistoryBlock <> Nil) Then Begin                { History initalized }
     AdvanceStringPtr;                                { Move to first string }
     While (CurString <> Nil) Do Begin
       Inc(Count);                                    { Add one to count }
       AdvanceStringPtr;                              { Move to next string }
     End;
  End;
  HistoryCount := Count;                              { Return history count }
END;

{---------------------------------------------------------------------------}
{  HistoryStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB        }
{---------------------------------------------------------------------------}
FUNCTION HistoryStr(Id: Byte; Index: Sw_Integer): String;
VAR I: Sw_Integer;
BEGIN
   StartId(Id);                                       { Set to first record }
   If (HistoryBlock <> Nil) Then Begin                { History initalized }
     For I := 0 To Index Do AdvanceStringPtr;         { Find indexed string }
     If (CurString <> Nil) Then
       HistoryStr := CurString^ Else                  { Return string }
       HistoryStr := '';                              { Index not found }
   End Else HistoryStr := '';                         { History uninitialized }
END;

{---------------------------------------------------------------------------}
{  ClearHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
{---------------------------------------------------------------------------}
PROCEDURE ClearHistory;
BEGIN
   If (HistoryBlock <> Nil) Then Begin                { History initiated }
     PChar(HistoryBlock)^ := #0;                      { Clear first byte }
     HistoryUsed := 1;        { Set position }
   End;
END;

{---------------------------------------------------------------------------}
{  HistoryAdd -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB        }
{---------------------------------------------------------------------------}
PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
BEGIN
   If (Str = '') Then Exit;                           { Empty string exit }
   If (HistoryBlock = Nil) Then Exit;                 { History uninitialized }
   StartId(Id);                                       { Set current data }
   AdvanceStringPtr;                                  { Find the string }
   While (CurString <> nil) Do Begin
     If (Str = CurString^) Then DeleteString;         { Delete duplicates }
     AdvanceStringPtr;                                { Find next string }
   End;
   InsertString(Id, Str);                             { Add new history item }
END;

function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
var
  I: Sw_Integer;
begin
  StartId(Id);
  for I := 0 to Index do
   AdvanceStringPtr;                                  { Find the string }
  if CurString <> nil then
    begin
       DeleteString;
       HistoryRemove:=true;
    end
  else
    HistoryRemove:=false;
end;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  LoadHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE LoadHistory (Var S: TStream);
VAR Size: sw_Word;
BEGIN
   S.Read(Size, sizeof(Size));                        { Read history size }
   If (HistoryBlock <> Nil) Then Begin                { History initialized }
     If (Size <= HistorySize) Then Begin
       S.Read(HistoryBlock^, Size);                   { Read the history }
       HistoryUsed := Size;                           { History used }
     End Else S.Seek(S.GetPos + Size);                { Move stream position }
   End Else S.Seek(S.GetPos + Size);                  { Move stream position }
END;

{---------------------------------------------------------------------------}
{  StoreHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
{---------------------------------------------------------------------------}
PROCEDURE StoreHistory (Var S: TStream);
VAR Size: sw_Word;
BEGIN
   If (HistoryBlock = Nil) Then Size := 0 Else        { No history data }
     Size := HistoryUsed;                             { Size of history data }
   S.Write(Size, sizeof(Size));                       { Write history size }
   If (Size > 0) Then S.Write(HistoryBlock^, Size);   { Write history data }
END;

END.

{
 $Log$
 Revision 1.11  2004-11-03 20:51:36  florian
   * fixed problems on targets requiring proper alignment

 Revision 1.10  2002/10/17 11:24:16  pierre
  * Clean up the Load/Store routines so they are endian independent

 Revision 1.9  2002/09/07 15:06:37  peter
   * old logs removed and tabs fixed

 Revision 1.8  2002/06/10 11:51:08  pierre
  * render history load/store compatible with older fvnew lib

 Revision 1.7  2002/06/03 20:07:44  pierre
  * DeleteString was moving to much memory

 Revision 1.6  2002/05/24 09:30:33  pierre
  * fix bug with HistoryUsed, now is really a used size

}