PageRenderTime 34ms CodeModel.GetById 19ms app.highlight 3ms RepoModel.GetById 0ms app.codeStats 0ms

/packages/fv/src/histlist.pas

https://github.com/slibre/freepascal
Pascal | 416 lines | 178 code | 45 blank | 193 comment | 7 complexity | 771b2afda4811b055309b995f9eef168 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
  1{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
  2{                                                          }
  3{   System independent GRAPHICAL clone of HISTLIST.PAS     }
  4{                                                          }
  5{   Interface Copyright (c) 1992 Borland International     }
  6{                                                          }
  7{   Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer   }
  8{   ldeboer@attglobal.net  - primary e-mail address        }
  9{   ldeboer@starwon.com.au - backup e-mail address         }
 10{                                                          }
 11{****************[ THIS CODE IS FREEWARE ]*****************}
 12{                                                          }
 13{     This sourcecode is released for the purpose to       }
 14{   promote the pascal language on all platforms. You may  }
 15{   redistribute it and/or modify with the following       }
 16{   DISCLAIMER.                                            }
 17{                                                          }
 18{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
 19{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
 20{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
 21{                                                          }
 22{*****************[ SUPPORTED PLATFORMS ]******************}
 23{     16 and 32 Bit compilers                              }
 24{        DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
 25{        DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
 26{                 - FPC 0.9912+ (GO32V2)    (32 Bit)       }
 27{        WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
 28{                 - Delphi 1.0+             (16 Bit)       }
 29{        WIN95/NT - Delphi 2.0+             (32 Bit)       }
 30{                 - Virtual Pascal 2.0+     (32 Bit)       }
 31{                 - Speedsoft Sybil 2.0+    (32 Bit)       }
 32{                 - FPC 0.9912+             (32 Bit)       }
 33{        OS2      - Virtual Pascal 1.0+     (32 Bit)       }
 34{                                                          }
 35{******************[ REVISION HISTORY ]********************}
 36{  Version  Date        Fix                                }
 37{  -------  ---------   ---------------------------------  }
 38{  1.00     11 Nov 96   First DOS/DPMI platform release.   }
 39{  1.10     13 Jul 97   Windows platform code added.       }
 40{  1.20     29 Aug 97   Platform.inc sort added.           }
 41{  1.30     13 Oct 97   Delphi 2 32 bit code added.        }
 42{  1.40     05 May 98   Virtual pascal 2.0 code added.     }
 43{  1.50     30 Sep 99   Complete recheck preformed         }
 44{  1.51     03 Nov 99   FPC windows support added          }
 45{**********************************************************}
 46
 47UNIT HistList;
 48
 49{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 50                                  INTERFACE
 51{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 52
 53{====Include file to sort compiler platform out =====================}
 54{$I platform.inc}
 55{====================================================================}
 56
 57{==== Compiler directives ===========================================}
 58
 59{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
 60  {$F-} { Short calls are okay }
 61  {$A+} { Word Align Data }
 62  {$B-} { Allow short circuit boolean evaluations }
 63  {$O+} { This unit may be overlaid }
 64  {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
 65  {$P-} { Normal string variables }
 66  {$N-} { No 80x87 code generation }
 67  {$E+} { Emulation is on }
 68{$ENDIF}
 69
 70{$X+} { Extended syntax is ok }
 71{$R-} { Disable range checking }
 72{$S-} { Disable Stack Checking }
 73{$I-} { Disable IO Checking }
 74{$Q-} { Disable Overflow Checking }
 75{$V-} { Turn off strict VAR strings }
 76{====================================================================}
 77
 78USES FVCommon, Objects;                                 { Standard GFV units }
 79
 80{***************************************************************************}
 81{                            INTERFACE ROUTINES                             }
 82{***************************************************************************}
 83
 84{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 85{                     HISTORY SYSTEM CONTROL ROUTINES                       }
 86{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 87
 88{-InitHistory--------------------------------------------------------
 89Initializes the history system usually called from Application.Init
 9030Sep99 LdB
 91---------------------------------------------------------------------}
 92PROCEDURE InitHistory;
 93
 94{-DoneHistory--------------------------------------------------------
 95Destroys the history system usually called from Application.Done
 9630Sep99 LdB
 97---------------------------------------------------------------------}
 98PROCEDURE DoneHistory;
 99
100{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
101{                          HISTORY ITEM ROUTINES                            }
102{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
103
104{-HistoryCount-------------------------------------------------------
105Returns the number of strings in the history list with ID number Id.
10630Sep99 LdB
107---------------------------------------------------------------------}
108FUNCTION HistoryCount (Id: Byte): Word;
109
110{-HistoryStr---------------------------------------------------------
111Returns the Index'th string in the history list with ID number Id.
11230Sep99 LdB
113---------------------------------------------------------------------}
114FUNCTION HistoryStr (Id: Byte; Index: Sw_Integer): String;
115
116{-ClearHistory-------------------------------------------------------
117Removes all strings from all history lists.
11830Sep99 LdB
119---------------------------------------------------------------------}
120PROCEDURE ClearHistory;
121
122{-HistoryAdd---------------------------------------------------------
123Adds the string Str to the history list indicated by Id.
12430Sep99 LdB
125---------------------------------------------------------------------}
126PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
127
128function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
129
130{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
131{              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
132{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
133
134{-LoadHistory--------------------------------------------------------
135Reads the application's history block from the stream S by reading the
136size of the block, then the block itself. Sets HistoryUsed to the end
137of the block read. Use LoadHistory to restore a history block saved
138with StoreHistory
13930Sep99 LdB
140---------------------------------------------------------------------}
141PROCEDURE LoadHistory (Var S: TStream);
142
143{-StoreHistory--------------------------------------------------------
144Writes the currently used portion of the history block to the stream
145S, first writing the length of the block then the block itself. Use
146the LoadHistory procedure to restore the history block.
14730Sep99 LdB
148---------------------------------------------------------------------}
149PROCEDURE StoreHistory (Var S: TStream);
150
151{***************************************************************************}
152{                        INITIALIZED PUBLIC VARIABLES                       }
153{***************************************************************************}
154{---------------------------------------------------------------------------}
155{                 INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                 }
156{---------------------------------------------------------------------------}
157CONST
158   HistorySize: sw_integer = 64*1024;                    { Maximum history size }
159   HistoryUsed: sw_integer = 0;                          { History used }
160   HistoryBlock: Pointer = Nil;                       { Storage block }
161
162{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
163                                IMPLEMENTATION
164{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
165
166{***************************************************************************}
167{                      PRIVATE RECORD DEFINITIONS                           }
168{***************************************************************************}
169
170{---------------------------------------------------------------------------}
171{                       THistRec RECORD DEFINITION
172
173   Zero  1 byte, start marker
174   Id    1 byte, History id
175   <shortstring>   1 byte length+string data, Contents
176}
177
178{***************************************************************************}
179{                      UNINITIALIZED PRIVATE VARIABLES                      }
180{***************************************************************************}
181{---------------------------------------------------------------------------}
182{                UNINITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES                }
183{---------------------------------------------------------------------------}
184VAR
185   CurId: Byte;                                       { Current history id }
186   CurString: PString;                                { Current string }
187
188{***************************************************************************}
189{                          PRIVATE UNIT ROUTINES                            }
190{***************************************************************************}
191
192{---------------------------------------------------------------------------}
193{  StartId -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB           }
194{---------------------------------------------------------------------------}
195PROCEDURE StartId (Id: Byte);
196BEGIN
197   CurId := Id;                                       { Set current id }
198   CurString := HistoryBlock;                         { Set current string }
199END;
200
201{---------------------------------------------------------------------------}
202{  DeleteString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
203{---------------------------------------------------------------------------}
204PROCEDURE DeleteString;
205VAR Len: Sw_Integer; P, P2: PChar;
206BEGIN
207   P := PChar(CurString);                             { Current string }
208   P2 := PChar(CurString);                            { Current string }
209   Len := PByte(P2)^+3;                               { Length of data }
210   Dec(P, 2);                                         { Correct position }
211   Inc(P2, PByte(P2)^+1);                             { Next hist record }
212   { Shuffle history }
213   Move(P2^, P^, Pointer(HistoryBlock) + HistoryUsed - Pointer(P2) );
214   Dec(HistoryUsed, Len);                             { Adjust history used }
215END;
216
217{---------------------------------------------------------------------------}
218{  AdvanceStringPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB  }
219{---------------------------------------------------------------------------}
220PROCEDURE AdvanceStringPtr;
221VAR P: PChar;
222BEGIN
223   While (CurString <> Nil) Do Begin
224     If (Pointer(CurString) >= Pointer(HistoryBlock) + HistoryUsed) Then Begin{ Last string check }
225       CurString := Nil;                              { Clear current string }
226       Exit;                                          { Now exit }
227     End;
228     Inc(PChar(CurString), PByte(CurString)^+1);      { Move to next string }
229     If (Pointer(CurString) >= Pointer(HistoryBlock) + HistoryUsed) Then Begin{ Last string check }
230       CurString := Nil;                              { Clear current string }
231       Exit;                                          { Now exit }
232     End;
233     P := PChar(CurString);                        { Transfer record ptr }
234     Inc(PChar(CurString), 2);                        { Move to string }
235     if (P^<>#0) then
236       RunError(215);
237     Inc(P);
238     If (P^ = Chr(CurId)) Then Exit;                    { Found the string }
239   End;
240END;
241
242{---------------------------------------------------------------------------}
243{  InsertString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
244{---------------------------------------------------------------------------}
245PROCEDURE InsertString (Id: Byte; Const Str: String);
246VAR P, P1, P2: PChar;
247BEGIN
248  while (HistoryUsed+Length(Str)+3>HistorySize) do
249   begin
250       P:=PChar(HistoryBlock);
251       while Pointer(P)<Pointer(HistoryBlock)+HistorySize do
252         begin
253           if Pointer(P)+Length(PShortString(P+2)^)+6+Length(Str) >
254              Pointer(HistoryBlock)+HistorySize then
255             begin
256               Dec(HistoryUsed,Length(PShortString(P+2)^)+3);
257               FillChar(P^,Pointer(HistoryBlock)+HistorySize-Pointer(P),#0);
258               break;
259             end;
260           Inc(P,Length(PShortString(P+2)^)+3);
261         end;
262   end;
263   P1 := PChar(HistoryBlock)+1;                     { First history record }
264   P2 := P1+Length(Str)+3;                          { History record after }
265   Move(P1^, P2^, HistoryUsed - 1);                 { Shuffle history data }
266   P1^:=#0;                         { Set marker byte }
267   Inc(P1);
268   P1^:=Chr(Id);                          { Set history id }
269   Inc(P1);
270   Move(Str[0], P1^, Length(Str)+1);  { Set history string }
271   Inc(HistoryUsed, Length(Str)+3);                 { Inc history used }
272END;
273
274{***************************************************************************}
275{                            INTERFACE ROUTINES                             }
276{***************************************************************************}
277
278{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
279{                     HISTORY SYSTEM CONTROL ROUTINES                       }
280{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
281
282{---------------------------------------------------------------------------}
283{  InitHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB       }
284{---------------------------------------------------------------------------}
285PROCEDURE InitHistory;
286BEGIN
287   if HistorySize>0 then
288     GetMem(HistoryBlock, HistorySize);                 { Allocate block }
289   ClearHistory;                                      { Clear the history }
290END;
291
292{---------------------------------------------------------------------------}
293{  DoneHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB       }
294{---------------------------------------------------------------------------}
295PROCEDURE DoneHistory;
296BEGIN
297   If (HistoryBlock <> Nil) Then                      { History block valid }
298     begin
299       FreeMem(HistoryBlock);              { Release history block }
300       HistoryBlock:=nil;
301     end;
302END;
303
304{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
305{                          HISTORY ITEM ROUTINES                            }
306{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
307
308{---------------------------------------------------------------------------}
309{  HistoryCount -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
310{---------------------------------------------------------------------------}
311FUNCTION HistoryCount(Id: Byte): Word;
312VAR Count: Word;
313BEGIN
314   StartId(Id);                                       { Set to first record }
315   Count := 0;                                        { Clear count }
316   If (HistoryBlock <> Nil) Then Begin                { History initalized }
317     AdvanceStringPtr;                                { Move to first string }
318     While (CurString <> Nil) Do Begin
319       Inc(Count);                                    { Add one to count }
320       AdvanceStringPtr;                              { Move to next string }
321     End;
322  End;
323  HistoryCount := Count;                              { Return history count }
324END;
325
326{---------------------------------------------------------------------------}
327{  HistoryStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB        }
328{---------------------------------------------------------------------------}
329FUNCTION HistoryStr(Id: Byte; Index: Sw_Integer): String;
330VAR I: Sw_Integer;
331BEGIN
332   StartId(Id);                                       { Set to first record }
333   If (HistoryBlock <> Nil) Then Begin                { History initalized }
334     For I := 0 To Index Do AdvanceStringPtr;         { Find indexed string }
335     If (CurString <> Nil) Then
336       HistoryStr := CurString^ Else                  { Return string }
337       HistoryStr := '';                              { Index not found }
338   End Else HistoryStr := '';                         { History uninitialized }
339END;
340
341{---------------------------------------------------------------------------}
342{  ClearHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
343{---------------------------------------------------------------------------}
344PROCEDURE ClearHistory;
345BEGIN
346   If (HistoryBlock <> Nil) Then Begin                { History initiated }
347     PChar(HistoryBlock)^ := #0;                      { Clear first byte }
348     HistoryUsed := 1;        { Set position }
349   End;
350END;
351
352{---------------------------------------------------------------------------}
353{  HistoryAdd -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB        }
354{---------------------------------------------------------------------------}
355PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
356BEGIN
357   If (Str = '') Then Exit;                           { Empty string exit }
358   If (HistoryBlock = Nil) Then Exit;                 { History uninitialized }
359   StartId(Id);                                       { Set current data }
360   AdvanceStringPtr;                                  { Find the string }
361   While (CurString <> nil) Do Begin
362     If (Str = CurString^) Then DeleteString;         { Delete duplicates }
363     AdvanceStringPtr;                                { Find next string }
364   End;
365   InsertString(Id, Str);                             { Add new history item }
366END;
367
368function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
369var
370  I: Sw_Integer;
371begin
372  StartId(Id);
373  for I := 0 to Index do
374   AdvanceStringPtr;                                  { Find the string }
375  if CurString <> nil then
376    begin
377       DeleteString;
378       HistoryRemove:=true;
379    end
380  else
381    HistoryRemove:=false;
382end;
383
384
385{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
386{              HISTORY STREAM STORAGE AND RETREIVAL ROUTINES                }
387{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
388
389{---------------------------------------------------------------------------}
390{  LoadHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB       }
391{---------------------------------------------------------------------------}
392PROCEDURE LoadHistory (Var S: TStream);
393VAR Size: sw_integer;
394BEGIN
395   S.Read(Size, sizeof(Size));                        { Read history size }
396   If (HistoryBlock <> Nil) Then Begin                { History initialized }
397     If (Size <= HistorySize) Then Begin
398       S.Read(HistoryBlock^, Size);                   { Read the history }
399       HistoryUsed := Size;                           { History used }
400     End Else S.Seek(S.GetPos + Size);                { Move stream position }
401   End Else S.Seek(S.GetPos + Size);                  { Move stream position }
402END;
403
404{---------------------------------------------------------------------------}
405{  StoreHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB      }
406{---------------------------------------------------------------------------}
407PROCEDURE StoreHistory (Var S: TStream);
408VAR Size: sw_integer;
409BEGIN
410   If (HistoryBlock = Nil) Then Size := 0 Else        { No history data }
411     Size := HistoryUsed;                             { Size of history data }
412   S.Write(Size, sizeof(Size));                       { Write history size }
413   If (Size > 0) Then S.Write(HistoryBlock^, Size);   { Write history data }
414END;
415
416END.