/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

  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. UNIT HistList;
  47. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  48. INTERFACE
  49. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  50. {====Include file to sort compiler platform out =====================}
  51. {$I platform.inc}
  52. {====================================================================}
  53. {==== Compiler directives ===========================================}
  54. {$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
  55. {$F-} { Short calls are okay }
  56. {$A+} { Word Align Data }
  57. {$B-} { Allow short circuit boolean evaluations }
  58. {$O+} { This unit may be overlaid }
  59. {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
  60. {$P-} { Normal string variables }
  61. {$N-} { No 80x87 code generation }
  62. {$E+} { Emulation is on }
  63. {$ENDIF}
  64. {$X+} { Extended syntax is ok }
  65. {$R-} { Disable range checking }
  66. {$S-} { Disable Stack Checking }
  67. {$I-} { Disable IO Checking }
  68. {$Q-} { Disable Overflow Checking }
  69. {$V-} { Turn off strict VAR strings }
  70. {====================================================================}
  71. USES FVCommon, Objects; { Standard GFV units }
  72. {***************************************************************************}
  73. { INTERFACE ROUTINES }
  74. {***************************************************************************}
  75. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  76. { HISTORY SYSTEM CONTROL ROUTINES }
  77. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  78. {-InitHistory--------------------------------------------------------
  79. Initializes the history system usually called from Application.Init
  80. 30Sep99 LdB
  81. ---------------------------------------------------------------------}
  82. PROCEDURE InitHistory;
  83. {-DoneHistory--------------------------------------------------------
  84. Destroys the history system usually called from Application.Done
  85. 30Sep99 LdB
  86. ---------------------------------------------------------------------}
  87. PROCEDURE DoneHistory;
  88. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  89. { HISTORY ITEM ROUTINES }
  90. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  91. {-HistoryCount-------------------------------------------------------
  92. Returns the number of strings in the history list with ID number Id.
  93. 30Sep99 LdB
  94. ---------------------------------------------------------------------}
  95. FUNCTION HistoryCount (Id: Byte): Word;
  96. {-HistoryStr---------------------------------------------------------
  97. Returns the Index'th string in the history list with ID number Id.
  98. 30Sep99 LdB
  99. ---------------------------------------------------------------------}
  100. FUNCTION HistoryStr (Id: Byte; Index: Sw_Integer): String;
  101. {-ClearHistory-------------------------------------------------------
  102. Removes all strings from all history lists.
  103. 30Sep99 LdB
  104. ---------------------------------------------------------------------}
  105. PROCEDURE ClearHistory;
  106. {-HistoryAdd---------------------------------------------------------
  107. Adds the string Str to the history list indicated by Id.
  108. 30Sep99 LdB
  109. ---------------------------------------------------------------------}
  110. PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
  111. function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
  112. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  113. { HISTORY STREAM STORAGE AND RETREIVAL ROUTINES }
  114. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  115. {-LoadHistory--------------------------------------------------------
  116. Reads the application's history block from the stream S by reading the
  117. size of the block, then the block itself. Sets HistoryUsed to the end
  118. of the block read. Use LoadHistory to restore a history block saved
  119. with StoreHistory
  120. 30Sep99 LdB
  121. ---------------------------------------------------------------------}
  122. PROCEDURE LoadHistory (Var S: TStream);
  123. {-StoreHistory--------------------------------------------------------
  124. Writes the currently used portion of the history block to the stream
  125. S, first writing the length of the block then the block itself. Use
  126. the LoadHistory procedure to restore the history block.
  127. 30Sep99 LdB
  128. ---------------------------------------------------------------------}
  129. PROCEDURE StoreHistory (Var S: TStream);
  130. {***************************************************************************}
  131. { INITIALIZED PUBLIC VARIABLES }
  132. {***************************************************************************}
  133. {---------------------------------------------------------------------------}
  134. { INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
  135. {---------------------------------------------------------------------------}
  136. CONST
  137. HistorySize: sw_integer = 64*1024; { Maximum history size }
  138. HistoryUsed: sw_integer = 0; { History used }
  139. HistoryBlock: Pointer = Nil; { Storage block }
  140. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  141. IMPLEMENTATION
  142. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  143. {***************************************************************************}
  144. { PRIVATE RECORD DEFINITIONS }
  145. {***************************************************************************}
  146. {---------------------------------------------------------------------------}
  147. { THistRec RECORD DEFINITION
  148. Zero 1 byte, start marker
  149. Id 1 byte, History id
  150. <shortstring> 1 byte length+string data, Contents
  151. }
  152. {***************************************************************************}
  153. { UNINITIALIZED PRIVATE VARIABLES }
  154. {***************************************************************************}
  155. {---------------------------------------------------------------------------}
  156. { UNINITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
  157. {---------------------------------------------------------------------------}
  158. VAR
  159. CurId: Byte; { Current history id }
  160. CurString: PString; { Current string }
  161. {***************************************************************************}
  162. { PRIVATE UNIT ROUTINES }
  163. {***************************************************************************}
  164. {---------------------------------------------------------------------------}
  165. { StartId -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  166. {---------------------------------------------------------------------------}
  167. PROCEDURE StartId (Id: Byte);
  168. BEGIN
  169. CurId := Id; { Set current id }
  170. CurString := HistoryBlock; { Set current string }
  171. END;
  172. {---------------------------------------------------------------------------}
  173. { DeleteString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  174. {---------------------------------------------------------------------------}
  175. PROCEDURE DeleteString;
  176. VAR Len: Sw_Integer; P, P2: PChar;
  177. BEGIN
  178. P := PChar(CurString); { Current string }
  179. P2 := PChar(CurString); { Current string }
  180. Len := PByte(P2)^+3; { Length of data }
  181. Dec(P, 2); { Correct position }
  182. Inc(P2, PByte(P2)^+1); { Next hist record }
  183. { Shuffle history }
  184. Move(P2^, P^, Pointer(HistoryBlock) + HistoryUsed - Pointer(P2) );
  185. Dec(HistoryUsed, Len); { Adjust history used }
  186. END;
  187. {---------------------------------------------------------------------------}
  188. { AdvanceStringPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  189. {---------------------------------------------------------------------------}
  190. PROCEDURE AdvanceStringPtr;
  191. VAR P: PChar;
  192. BEGIN
  193. While (CurString <> Nil) Do Begin
  194. If (Pointer(CurString) >= Pointer(HistoryBlock) + HistoryUsed) Then Begin{ Last string check }
  195. CurString := Nil; { Clear current string }
  196. Exit; { Now exit }
  197. End;
  198. Inc(PChar(CurString), PByte(CurString)^+1); { Move to next string }
  199. If (Pointer(CurString) >= Pointer(HistoryBlock) + HistoryUsed) Then Begin{ Last string check }
  200. CurString := Nil; { Clear current string }
  201. Exit; { Now exit }
  202. End;
  203. P := PChar(CurString); { Transfer record ptr }
  204. Inc(PChar(CurString), 2); { Move to string }
  205. if (P^<>#0) then
  206. RunError(215);
  207. Inc(P);
  208. If (P^ = Chr(CurId)) Then Exit; { Found the string }
  209. End;
  210. END;
  211. {---------------------------------------------------------------------------}
  212. { InsertString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  213. {---------------------------------------------------------------------------}
  214. PROCEDURE InsertString (Id: Byte; Const Str: String);
  215. VAR P, P1, P2: PChar;
  216. BEGIN
  217. while (HistoryUsed+Length(Str)+3>HistorySize) do
  218. begin
  219. P:=PChar(HistoryBlock);
  220. while Pointer(P)<Pointer(HistoryBlock)+HistorySize do
  221. begin
  222. if Pointer(P)+Length(PShortString(P+2)^)+6+Length(Str) >
  223. Pointer(HistoryBlock)+HistorySize then
  224. begin
  225. Dec(HistoryUsed,Length(PShortString(P+2)^)+3);
  226. FillChar(P^,Pointer(HistoryBlock)+HistorySize-Pointer(P),#0);
  227. break;
  228. end;
  229. Inc(P,Length(PShortString(P+2)^)+3);
  230. end;
  231. end;
  232. P1 := PChar(HistoryBlock)+1; { First history record }
  233. P2 := P1+Length(Str)+3; { History record after }
  234. Move(P1^, P2^, HistoryUsed - 1); { Shuffle history data }
  235. P1^:=#0; { Set marker byte }
  236. Inc(P1);
  237. P1^:=Chr(Id); { Set history id }
  238. Inc(P1);
  239. Move(Str[0], P1^, Length(Str)+1); { Set history string }
  240. Inc(HistoryUsed, Length(Str)+3); { Inc history used }
  241. END;
  242. {***************************************************************************}
  243. { INTERFACE ROUTINES }
  244. {***************************************************************************}
  245. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  246. { HISTORY SYSTEM CONTROL ROUTINES }
  247. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  248. {---------------------------------------------------------------------------}
  249. { InitHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  250. {---------------------------------------------------------------------------}
  251. PROCEDURE InitHistory;
  252. BEGIN
  253. if HistorySize>0 then
  254. GetMem(HistoryBlock, HistorySize); { Allocate block }
  255. ClearHistory; { Clear the history }
  256. END;
  257. {---------------------------------------------------------------------------}
  258. { DoneHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  259. {---------------------------------------------------------------------------}
  260. PROCEDURE DoneHistory;
  261. BEGIN
  262. If (HistoryBlock <> Nil) Then { History block valid }
  263. begin
  264. FreeMem(HistoryBlock); { Release history block }
  265. HistoryBlock:=nil;
  266. end;
  267. END;
  268. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  269. { HISTORY ITEM ROUTINES }
  270. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  271. {---------------------------------------------------------------------------}
  272. { HistoryCount -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  273. {---------------------------------------------------------------------------}
  274. FUNCTION HistoryCount(Id: Byte): Word;
  275. VAR Count: Word;
  276. BEGIN
  277. StartId(Id); { Set to first record }
  278. Count := 0; { Clear count }
  279. If (HistoryBlock <> Nil) Then Begin { History initalized }
  280. AdvanceStringPtr; { Move to first string }
  281. While (CurString <> Nil) Do Begin
  282. Inc(Count); { Add one to count }
  283. AdvanceStringPtr; { Move to next string }
  284. End;
  285. End;
  286. HistoryCount := Count; { Return history count }
  287. END;
  288. {---------------------------------------------------------------------------}
  289. { HistoryStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  290. {---------------------------------------------------------------------------}
  291. FUNCTION HistoryStr(Id: Byte; Index: Sw_Integer): String;
  292. VAR I: Sw_Integer;
  293. BEGIN
  294. StartId(Id); { Set to first record }
  295. If (HistoryBlock <> Nil) Then Begin { History initalized }
  296. For I := 0 To Index Do AdvanceStringPtr; { Find indexed string }
  297. If (CurString <> Nil) Then
  298. HistoryStr := CurString^ Else { Return string }
  299. HistoryStr := ''; { Index not found }
  300. End Else HistoryStr := ''; { History uninitialized }
  301. END;
  302. {---------------------------------------------------------------------------}
  303. { ClearHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  304. {---------------------------------------------------------------------------}
  305. PROCEDURE ClearHistory;
  306. BEGIN
  307. If (HistoryBlock <> Nil) Then Begin { History initiated }
  308. PChar(HistoryBlock)^ := #0; { Clear first byte }
  309. HistoryUsed := 1; { Set position }
  310. End;
  311. END;
  312. {---------------------------------------------------------------------------}
  313. { HistoryAdd -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  314. {---------------------------------------------------------------------------}
  315. PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
  316. BEGIN
  317. If (Str = '') Then Exit; { Empty string exit }
  318. If (HistoryBlock = Nil) Then Exit; { History uninitialized }
  319. StartId(Id); { Set current data }
  320. AdvanceStringPtr; { Find the string }
  321. While (CurString <> nil) Do Begin
  322. If (Str = CurString^) Then DeleteString; { Delete duplicates }
  323. AdvanceStringPtr; { Find next string }
  324. End;
  325. InsertString(Id, Str); { Add new history item }
  326. END;
  327. function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
  328. var
  329. I: Sw_Integer;
  330. begin
  331. StartId(Id);
  332. for I := 0 to Index do
  333. AdvanceStringPtr; { Find the string }
  334. if CurString <> nil then
  335. begin
  336. DeleteString;
  337. HistoryRemove:=true;
  338. end
  339. else
  340. HistoryRemove:=false;
  341. end;
  342. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  343. { HISTORY STREAM STORAGE AND RETREIVAL ROUTINES }
  344. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  345. {---------------------------------------------------------------------------}
  346. { LoadHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  347. {---------------------------------------------------------------------------}
  348. PROCEDURE LoadHistory (Var S: TStream);
  349. VAR Size: sw_integer;
  350. BEGIN
  351. S.Read(Size, sizeof(Size)); { Read history size }
  352. If (HistoryBlock <> Nil) Then Begin { History initialized }
  353. If (Size <= HistorySize) Then Begin
  354. S.Read(HistoryBlock^, Size); { Read the history }
  355. HistoryUsed := Size; { History used }
  356. End Else S.Seek(S.GetPos + Size); { Move stream position }
  357. End Else S.Seek(S.GetPos + Size); { Move stream position }
  358. END;
  359. {---------------------------------------------------------------------------}
  360. { StoreHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  361. {---------------------------------------------------------------------------}
  362. PROCEDURE StoreHistory (Var S: TStream);
  363. VAR Size: sw_integer;
  364. BEGIN
  365. If (HistoryBlock = Nil) Then Size := 0 Else { No history data }
  366. Size := HistoryUsed; { Size of history data }
  367. S.Write(Size, sizeof(Size)); { Write history size }
  368. If (Size > 0) Then S.Write(HistoryBlock^, Size); { Write history data }
  369. END;
  370. END.