7 Data: NameStringPointer;
13 Avail, Empty: NSPoolP;
17 AvailString : TextString;
18 NameList : BinNodePointer;
19 AvailNameList : BinNodePointer;
23 (*------------------------------------------------------------------*)
24 (* InitializeStringPackage *)
25 (*------------------------------------------------------------------*)
26 procedure InitializeStringPackage;
27 begin (* InitializeStringPackage *)
29 end; (* InitializeStringPackage *)
31 (*------------------------------------------------------------------*)
33 (*------------------------------------------------------------------*)
34 function newtextstring; (*: TextString;*)
37 begin (* newtextstring *)
38 if AvailString = nil then
42 AvailString := Temp^.Next;
44 Temp^.String.Length := 0;
46 newtextstring := Temp;
47 end; (* newtextstring *)
49 (*------------------------------------------------------------------*)
50 (* disposetextstring *)
51 (*------------------------------------------------------------------*)
52 procedure disposetextstring;(*(
53 var S : TextString);*)
57 begin (* disposetextstring *)
58 if S <> nil then begin
61 while Temp^.Next <> nil do
63 Temp^.Next := AvailString;
73 end; (* disposetextstring *)
75 (*------------------------------------------------------------------*)
77 (*------------------------------------------------------------------*)
79 ToString : TextString;
80 S : TextString) : TextString;*)
85 if ToString = nil then
86 writeln (output, 'Error in ConcatT, ToString is nil')
89 writeln (output, 'Error in ConcatT, S is nil')
91 if S^.Next <> nil then
93 'Error in ConcatT, S contains several linked TextStrings')
95 while ToString^.Next <> nil do
96 ToString := ToString^.Next;
97 if ToString^.String.Length+S^.String.Length > NameStringLength then begin
98 ToString^.Next := newtextstring;
99 ToString := ToString^.Next;
101 with ToString^, String do begin
102 for Index := 1 to S^.String.Length do
103 Value[Length+Index] := S^.String.Value[Index];
104 Length := Length+S^.String.Length;
109 (*------------------------------------------------------------------*)
110 (* AppendTextString *)
111 (*------------------------------------------------------------------*)
112 function AppendTextString;(*(
113 ToString : TextString;
114 S : TextString) : TextString;*)
115 begin (* AppendTextString *)
116 AppendTextString := ToString;
117 if ToString = nil then
118 writeln (output, 'Error in AppendTextString, ToString is nil')
121 writeln (output, 'Error in AppendTextString, S is nil')
123 while ToString^.Next <> nil do
124 ToString := ToString^.Next;
127 end; (* AppendTextString *)
129 (*------------------------------------------------------------------*)
131 (*------------------------------------------------------------------*)
132 function CopyTextString;(*(
137 begin (* CopyTextString *)
138 if S <> nil then begin
139 Temp := newtextstring;
140 Temp^.String := S^.String;
141 Temp^.Next := CopyTextString(S^.Next);
142 CopyTextString := Temp;
145 CopyTextString := nil;
146 end; (* CopyTextString *)
148 (*------------------------------------------------------------------*)
149 (* CONVERT_CHARSTRING_TO_VALUE *)
150 (*------------------------------------------------------------------*)
151 procedure CONVERT_CHARSTRING_TO_VALUE;(*(
153 var V : NameString);*)
158 begin (* CONVERT_CHARSTRING_TO_VALUE *)
160 for Pos := 2 to S.Length - 1 do begin
162 if not ((Ch = '''') and (Pos > 2) and (S.Value[Pos - 1] = '''')) then
167 end; (* CONVERT_CHARSTRING_TO_VALUE *)
169 (*------------------------------------------------------------------*)
171 (*------------------------------------------------------------------*)
172 procedure append_string;(*(
173 var Txt : TextString;
174 var String : NameString);*)
177 begin (* append_string *)
178 Temp := newtextstring;
179 Temp^.String := String;
183 Txt := AppendTextString(Txt, Temp);
184 end; (* append_string *)
186 function To_Upper;(*(ch:char) : char;*)
188 if ch in ['a'..'z'] then
189 To_Upper := chr(ord(ch) + ord('A')-ord('a'))
194 function To_Lower;(*(ch:char) : char;*)
196 if ch in ['A'..'Z'] then
197 To_Lower := chr(ord(ch) - ord('A') + ord('a'))
202 (*----------------------------------------------------------------------*)
203 (* Operations on NameString *)
204 (*----------------------------------------------------------------------*)
206 (*------------------------------------------------------------------*)
208 (*------------------------------------------------------------------*)
209 function EmptyNmStr(* : NameString*);
212 begin (* EmptyNmStr *)
215 end; (* EmptyNmStr *)
218 (* returns a namestring containing one character, the inparameter Ch *)
219 function chartonmstr; (*(
220 Ch : Char) : NameString; *)
224 String.Value[1] := Ch;
226 chartonmstr := String;
229 (* returns a namestring containing the inparameter Str in lowercase letters *)
230 function LowerCaseNmStr; (*(
231 Str : NameString) : NameString; *)
234 begin (* LowerCaseNmStr *)
236 for i := 1 to Length do
237 Value[i] := To_Lower(Value[i]);
238 LowerCaseNmStr := Str;
239 end; (* LowerCaseNmStr *)
241 (* returns a namestring containing inparameter S1 concatenated with inpar. S2 *)
242 function concatenatenamestrings; (*(
244 S2 : NameString) : NameString; *)
248 begin (* concatenatenamestrings *)
252 while Pos < S2.Length do begin
254 if Length < NameStringLength then begin
255 Length := Length + 1;
256 Value[Length] := S2.Value[Pos];
260 concatenatenamestrings := Temp;
261 end; (* concatenatenamestrings *)
263 procedure writenamestring;(*(
265 var Name : NameString);*)
270 for Pos := 1 to Length do
271 write(TextFile, Value[Pos]);
274 (*------------------------------------------------------------------*)
276 (*------------------------------------------------------------------*)
277 function IsControlChar; (*(
278 Ch : char) : boolean; *)
279 begin (* IsControlChar *)
280 IsControlChar := ord(Ch) in [0..32, 127];
281 end; (* IsControlChar *)
283 function namestringequal;(*(var Name1,Name2 : NameString) : Boolean;*)
287 if Name1.Length = Name2.Length then begin
290 while (i <= Name1.Length) and equal do begin
291 equal := To_Upper(Name1.Value[i]) = To_Upper(Name2.Value[i]);
294 namestringequal := equal;
297 namestringequal := false;
300 (* Character strings are case sensitive *)
302 function NameStringLess;(*(var Name1,Name2 : NameString) : Boolean;*)
303 var i, minlength : Integer;
306 Charstring : boolean;
310 if Name1.Length < Name2.Length then
311 minlength := Name1.Length
313 minlength := Name2.Length;
314 if MinLength > 0 then
315 Charstring := (Name1.Value[1] = '''') or (Name2.Value[1] = '''')
318 (* Charstring := true; force case sensitive *)
321 if i <= minlength then
322 while (i <= minlength) and equal do begin
323 if Charstring then begin
324 C1 := Name1.Value[i];
325 C2 := Name2.Value[i];
328 C1 := To_Upper(Name1.Value[i]);
329 C2 := To_Upper(Name2.Value[i]);
335 NameStringLess := Name1.Length < Name2.Length
337 NameStringLess := C1 < C2;
340 (*------------------------------------------------------------------*)
341 (* IsControlCharName *)
342 (*------------------------------------------------------------------*)
343 function IsControlCharName(
345 Pos : integer) : boolean;
346 begin (* IsControlCharName *)
348 if Pos <= Length then
349 IsControlCharName := IsControlChar(Value[Pos])
351 IsControlCharName := false;
353 end; (* IsControlCharName *)
355 (*------------------------------------------------------------------*)
357 (*------------------------------------------------------------------*)
358 function SubString; (*(
361 Len : integer) : NameString; *)
364 begin (* SubString *)
367 for i := Start to Start + Len - 1 do
368 Value[i- Start + 1] := Value[i]
376 (*------------------------------------------------------------------*)
378 (*------------------------------------------------------------------*)
379 function SkipChars; (*(
382 Len : integer) : NameString; *)
385 begin (* SkipChars *)
387 for i := Start to Length - Len do
388 Value[i] := Value[i + Len];
389 Length := Length - Len;
394 (*------------------------------------------------------------------*)
395 (* RemoveUnderlineControl *)
396 (*------------------------------------------------------------------*)
397 function RemoveUnderlineControl; (*(
398 Str : NameString) : NameString; *)
403 begin (* RemoveUnderlineControl *)
406 while i <= Length do begin
407 if Value[i] = '_' then begin
410 while IsControlCharName(Str, i + 1 + Len) do
413 Str := SkipChars(Str, Start, Len + 1)
421 RemoveUnderlineControl := Str;
422 end; (* RemoveUnderlineControl *)
424 (*------------------------------------------------------------------*)
426 (*------------------------------------------------------------------*)
427 procedure First100Chars; (*(
429 var Str : NameString;
430 var Truncated : boolean); *)
434 begin (* First100Chars *)
436 if Txt <> nil then begin
440 while (Txt <> nil) and (Str.Length < NameStringLength) do
441 with Txt^, String do begin
442 Str.Length := Str.Length + 1;
443 Str.Value[Str.Length] := ' ';
444 if Str.Length + Length <= NameStringLength then
445 Len := Str.Length + Length
447 Len := NameStringLength;
448 for i := Str.Length + 1 to Len do
449 Str.Value[i] := Value[i - Str.Length];
452 end; (* while with *)
453 Truncated := Txt <> nil;
454 end; (* First100Chars *)
457 (*------------------------------------------------------------------*)
459 (*------------------------------------------------------------------*)
460 (* changes I to contain the first index in Str (starting at I) that *)
462 procedure SkipSpaces; (* (Str : NameString; var I : Integer);*)
464 begin (* SkipSpaces *)
466 while (I < Str.Length) and not Stop do
467 if Str.Value[I] <> ' ' then
471 end; (* SkipSpaces *)
474 (*------------------------------------------------------------------*)
476 (*------------------------------------------------------------------*)
477 function SkipBlanks; (*(
478 TextLine: NameString) : NameString; *)
482 SpaceFound : boolean;
483 begin (* SkipBlanks *)
484 with TextLine do begin
487 while SpaceFound and (i <= Length) do begin
488 SpaceFound := (Value[i] in [' ', chr(9)]);
494 for j := 1 to Length - i do
495 if j <= Length - i then
496 Value[j] := Value[j + i];
497 Length := Length - i;
499 SkipBlanks := TextLine;
500 end; (* SkipBlanks *)
502 (*------------------------------------------------------------------*)
504 (*------------------------------------------------------------------*)
505 function stripname; (* (
506 TextLine: NameString) : NameString; *)
508 SpaceFound : boolean;
509 begin (* stripname *)
510 TextLine := SkipBlanks(TextLine);
511 with TextLine do begin
513 while SpaceFound and (Length > 0) do begin
514 SpaceFound := (Value[Length ] in [' ', chr(9)]);
516 Length := Length - 1;
519 stripname := TextLine;
524 Chars : SetOfChar) : integer; *)
532 while not Found and (Pos < Length) do begin
534 Found := Value[Pos] in Chars;
540 (*------------------------------------------------------------------*)
542 (*------------------------------------------------------------------*)
543 function NameHasChar; (* (TheName : NameString; TheChar : char) : boolean;*)
547 begin (* NameHasChar *)
550 while not found and (i < TheName.Length) do begin
552 found := TheName.Value[i] = TheChar;
554 NameHasChar := found;
555 end; (* NameHasChar *)
558 (*------------------------------------------------------------------*)
560 (*------------------------------------------------------------------*)
561 function integertonmstr; (* (TheInteger : integer) : NameString; *)
565 TempNumber : integer;
566 begin (* integertonmstr *)
568 TempNumber := TheInteger;
569 while TempNumber div 10 > 0 do begin
571 TempNumber := TempNumber div 10;
574 TempNumber := TheInteger;
575 for Index := Size downto 1 do begin
576 Nm.Value[Index] := chr(TempNumber mod 10 + ord('0'));
577 TempNumber := TempNumber div 10;
579 integertonmstr := Nm;
580 end; (* integertonmstr *)
582 (*------------------------------------------------------------------*)
584 (*------------------------------------------------------------------*)
585 function NmStrToInteger; (* (Str : NameString) : integer; *)
590 begin (* NmStrToInteger *)
591 Max := (maxint div 10) - 10;
593 for Index := 1 to Str.Length do begin
594 if (Numb <= Max) and (Str.Value[Index] in ['0'..'9']) then
595 Numb := 10 * Numb + ord(Str.Value[Index]) - ord('0');
597 NmStrToInteger := Numb;
598 end; (* NmStrToInteger *)
600 function AddNullToNmStr; (*(
601 Nm : NameString) : NameString; *)
602 begin (* AddNullToNmStr *)
604 if Length < NameStringLength then
605 Value[Length + 1] := chr(0)
607 Value[Length] := chr(0);
608 AddNullToNmStr := Nm;
609 end; (* AddNullToNmStr *)
611 function ValToNmStr; (*(
612 Nm : NameString) : NameString; *)
613 begin (* ValToNmStr *)
616 while value[length + 1] <> chr(0) do
617 length := length + 1;
620 end; (* ValToNmStr *)
622 (*------------------------------------------------------------------*)
624 (*------------------------------------------------------------------*)
625 function ChangeFileType; (*(FileName : NameString;
626 NewType : NameString) : NameString;*)
630 begin (* ChangeFileType *)
631 with Filename do begin
632 Pos := FileName.Length;
634 while not Found and (Pos > 0) do begin
635 Found := Value[Pos] = '.';
641 ChangeFileType := concatenatenamestrings(FileName, NewType);
642 end; (* ChangeFileType*)
644 (*------------------------------------------------------------------*)
646 (*------------------------------------------------------------------*)
647 function StripPath; (*(
648 Str : NameString) : NameString; *)
653 begin (* StripPath *)
657 while not Found and (i > 0) do begin
658 Found := Value[i] in ['/', '\'];
663 Len := Length - i + 1;
664 if i < Length then begin
668 StripPath := SubString(Str, i, Len);
675 function ReprOfChar; (*( ch : char) : NameString;*)
679 if (ch >= ' ') and (ch <= '~') then
680 Repr := chartonmstr(ch)
682 Repr := concatenatenamestrings(concatenatenamestrings(chartonmstr('<'),
683 integertonmstr(ord(ch))), chartonmstr('>'));
685 end; (* ReprOfChar *)
687 (*------------------------------------------------------------------*)
688 (* ExtractCommentInfo *)
689 (*------------------------------------------------------------------*)
690 (* check if Comment contains graphic reference or include directive *)
691 (* /*#<graphref>*/ or /*#<include-dir>*/ *)
692 (* <graphref> =G pagename xcoord ycoord *)
693 (* T pagename xcoord ycoord *)
694 (* M diagramtype diagramname pagename xcoord ycoord *)
696 (* <include-dir> =INCLUDE 'filename' *)
697 (* InfoType will contain the type of the comment *)
698 (* Info will contain <graphref> or the filename in <include-dir> if *)
699 (* the Comment isn't an ordinary comment *)
700 (* /*#E*/ do not count this line *)
701 (* /*#S*/ substructure generated from graphic short hand *)
702 procedure ExtractCommentInfo; (*(
705 var InfoType : TypeOfComment); *)
708 CommentMarkLength = 2;
709 IncludeMarkLength = 7; (* = INCLUDE *)
713 begin (* ExtractCommentInfo *)
715 with Comment do begin
716 InfoType := Ordinary;
717 StartIndex := CommentMarkLength + 1;
718 if Length > StartIndex then
719 if Value[StartIndex] = '#' then
720 if Value[StartIndex+1] in ['I','i', 'S'] then begin
721 if (Value[StartIndex+1] = 'S') and (Length = StartIndex+1+2) then
722 InfoType := SubstrShortHand
723 else if (Value[StartIndex+1] = 'S') and
724 (Length > StartIndex + GRRefLen) then begin
725 if Value[StartIndex+2] = 'D' then
726 if Value[StartIndex+3] = 'T' then
727 if Value[StartIndex+4] = 'R' then
728 if Value[StartIndex+5] = 'E' then
729 if Value[StartIndex+6] = 'F' then
733 if Length > StartIndex + IncludeMarkLength then
734 if Value[StartIndex+2] in ['N','n'] then
735 if Value[StartIndex+3] in ['C','c'] then
736 if Value[StartIndex+4] in ['L','l'] then
737 if Value[StartIndex+5] in ['U','u'] then
738 if Value[StartIndex+6] in ['D','d'] then
739 if Value[StartIndex+7] in ['E','e'] then
740 InfoType := IncludeClause;
744 if InfoType = IncludeClause then begin
745 InfoType := Ordinary;
746 StartIndex := StartIndex + IncludeMarkLength + 1;
747 if StartIndex+3 <= Length-2 then (* excluding the comment-end '*/' *) begin
748 if Value[StartIndex] = ' ' then begin
749 while (StartIndex <= Length-2) and (Value[StartIndex] = ' ') do
750 StartIndex := StartIndex + 1; (* Skip the spaces *)
751 if Value[StartIndex] = '''' then begin
752 Index := StartIndex+1;
753 while (Index <= Length-2) and (Value[Index] <> '''') do begin
754 Info.Value[Index-StartIndex] := Value[Index];
757 if Value[Index] = '''' then begin
758 Info.Length := Index - StartIndex - 1;
760 while (Index <= Length-2) and (Value[Index] = ' ') do
761 Index := Index + 1; (* Skip the ending spaces *)
762 if Index = Length-1 then
763 InfoType := IncludeClause; (* => a correct include directive *)
769 else if InfoType = SubstrShortHand then
770 Info := chartonmstr('S')
771 else if InfoType = GRRef then begin
772 if (Value[Length] = '/') and (Value[Length - 1] = '*') then
773 Info := SubString(Comment, StartIndex, Length - StartIndex + 1 - 2)
775 Info := SubString(Comment, StartIndex, Length - StartIndex + 1);
778 end; (* ExtractCommentInfo *)
780 (*---------------------------------------------------------------------------*)
781 (* inserts a node in a binary tree sorted after value. If node
782 is in tree Found returns true. *)
784 procedure INSERT_TREE_NODE;(*(
785 New_node: BinNodePointer; node to insert
786 var Node: BinNodePointer; tree to insert in
787 var FoundNode : BinNodePointer;
788 var Found : boolean; return status of operation
789 var Higher: boolean); returned true if the subtree height has
794 Node_1, (* helpvariable to rotate nodes *)
795 Node_2: BinNodePointer; (* helpvariable to rotate nodes *)
800 begin (* Value is not in tree, insert *)
807 (* New_node^.Value < Node^.Value *)
808 if NameStringLess(New_node^.NameP^, Node^.NameP^) then
809 begin (* New Value is lower than actual Value *)
810 INSERT_TREE_NODE( New_node, Node^.left, FoundNode, Found, Higher);
812 if Higher then (* left bransch has grown higher *)
824 -1: begin (* rebalance *)
827 if Node_1^.bal = -1 then
828 begin (* single LL rotation *)
829 Node^.left:= Node_1^.right;
830 Node_1^.right:= Node;
836 begin (* double LR rotation *)
837 Node_2:= Node_1^.right;
838 Node_1^.right:= Node_2^.left;
839 Node_2^.left:= Node_1;
840 Node^.left:= Node_2^.right;
841 Node_2^.right:= Node;
843 if Node_2^.bal = -1 then
848 if Node_2^.bal = 1 then
857 end; (* end case Node^.bal of *)
861 (* New_node^.value > Node^.value *)
862 if NameStringLess(Node^.NameP^, New_Node^.NameP^) then
863 begin (* New value is higher than actual value *)
864 INSERT_TREE_NODE( New_node, Node^.right, FoundNode, Found, Higher);
866 if Higher then (* Right bransch has grown higher *)
878 1: begin (* Rebalance *)
879 Node_1:= Node^.right;
881 if Node_1^.bal = 1 then
882 begin (* single RR rotation *)
883 Node^.right:= Node_1^.left;
889 begin (* double RL rotation *)
890 Node_2:= Node_1^.left;
891 Node_1^.left:= Node_2^.right;
892 Node_2^.right:= Node_1;
893 Node^.right:= Node_2^.left;
896 if Node_2^.bal = 1 then
901 if Node_2^.bal = -1 then
910 end; (* end case Node^.bal of *)
913 begin (* New value is equal to actual value *)
918 end; (* end INSERT_TREE_NODE *)
920 function GetNameList; (* : BinNodePointer;*)
922 GetNameList := NameList;
925 procedure DisposeANameList(
926 var NodeP : BinNodePointer);
927 begin (* DisposeANameList *)
928 if NodeP <> nil then begin
929 DisposeANameList(NodeP^.Left);
930 DisposeANameList(NodeP^.Right);
931 NodeP^.Left := AvailNameList;
933 AvailNameList := NodeP;
936 end; (* DisposeANameList *)
938 procedure DisposeNameList;
940 DisposeANameList(NameList);
943 function GetNewNameListNode;(*(
944 var Name : NameString) : BinNodePointer;*)
946 NodeP : BinNodePointer;
947 begin (* GetNewNameListNode *)
948 if AvailNameList = nil then begin
959 NodeP := AvailNameList;
960 AvailNameList := NodeP^.Left;
967 GetNewNameListNode := NodeP;
968 end; (* GetNewNameListNode *)
970 (*---------------------------------------------------------------------------*)
972 function insertname;(*(
974 var Found : boolean) : NameStringPointer;*)
977 NodeP : BinNodePointer;
978 FoundNode : BinNodePointer;
979 begin (* insertname *)
980 NodeP := GetNewNameListNode(Name);
982 INSERT_TREE_NODE(NodeP, NameList, FoundNode, Found, Higher);
983 insertname := FoundNode^.NameP;
985 DisposeANameList(NodeP);
986 end; (* insertname *)
988 procedure InitNameList;
991 AvailNameList := nil;
994 (********************************************************************)
995 (* NameString - Dynamic Memory Allocation *)
996 (********************************************************************)
998 procedure InitNameStringPool;
1000 GlobalNSPool.Avail := nil;
1001 GlobalNSPool.Empty := nil;
1004 procedure NewNameString; (* (var NSP: NameStringPointer );*)
1005 (*var Temp: NSPoolP;*)
1008 if GlobalNSPool.Avail=nil then
1011 Temp := GlobalNSPool.Avail;
1012 GlobalNSPool.Avail := Temp^.Next;
1013 Temp^.Next := GlobalNSPool.Empty;
1014 GlobalNSPool.Empty := Temp;
1022 procedure ReleaseNameString; (* (var NSP: NameStringPointer );*)
1023 (*var Temp: NSPoolP;*)
1025 if NSP <> nil then begin
1027 if GlobalNSPool.Empty=nil then begin
1029 Temp^.Next := GlobalNSPool.Avail;
1030 GlobalNSPool.Avail := Temp;
1033 Temp := GlobalNSPool.Empty;
1034 GlobalNSPool.Empty := Temp^.Next;
1035 Temp^.Next := GlobalNSPool.Avail;
1036 GlobalNSPool.Avail := Temp;
1045 procedure SDTrefStringToRec (* (
1046 var S : SDTrefString;
1048 var Error : integer) *) ;
1050 (* Converts SDTrefString S to a record R (SDTrefRec). If an error is
1051 detected Error is on exit the position in S where the error where
1052 detected. If correct Error is 0. *)
1057 ErrorFound, EndFound : Boolean;
1059 procedure SDTrefSkipSpaces;
1060 var Found : Boolean;
1063 while not Found and (Len <= S.Length) do
1064 if (S.Value[Len] = ' ') or (S.Value[Len] = chr(9)) then
1070 function SDTrefIsEnd : Boolean;
1072 SDTrefIsEnd := false;
1073 if S.Value[Len] = ')' then
1077 if Len > S.Length then
1078 SDTrefIsEnd := true;
1082 function SDTrefGetInteger : integer;
1089 while not Found and (Temp.Length <= NameStringLength) and
1090 (Len <= S.Length) do
1091 if S.Value[Len] in ['0'..'9'] then
1093 Temp.Length := Temp.Length+1;
1094 Temp.Value[Temp.Length] := S.Value[Len];
1099 if Temp.Length > 0 then
1100 SDTrefGetInteger := NmStrToInteger(Temp)
1102 SDTrefGetInteger := SDTrefUndefInt;
1108 R.FileName.Length := 0;
1109 R.PageName.Length := 0;
1110 R.ObjectId := SDTrefUndefInt;
1111 R.XCoord := SDTrefUndefInt;
1112 R.YCoord := SDTrefUndefInt;
1113 R.LineNumber := SDTrefUndefInt;
1114 R.Column := SDTrefUndefInt;
1117 if S.Length = 0 then goto 99;
1118 if S.Value[1] <> '#' then goto 99;
1120 if S.Value[2] <> 'S' then goto 99;
1122 if S.Value[3] <> 'D' then goto 99;
1124 if S.Value[4] <> 'T' then goto 99;
1126 if S.Value[5] <> 'R' then goto 99;
1128 if S.Value[6] <> 'E' then goto 99;
1130 if S.Value[7] <> 'F' then goto 99;
1132 if S.Value[8] <> '(' then goto 99;
1135 if S.Value[9] = 'S' then
1138 if S.Value[10] <> 'D' then goto 99;
1140 if S.Value[11] <> 'L' then goto 99;
1141 Len := 12; SDTrefSkipSpaces;
1142 if Len > S.Length then goto 99;
1145 if S.Value[Len] <> ',' then goto 99;
1146 Len := Len+1; SDTrefSkipSpaces;
1147 if Len > S.Length then goto 99;
1151 while not EndFound and (Len <= S.Length) do
1152 if S.Value[Len] in [',', ')', '(', ' ', chr(9)] then
1156 R.FileName.Length := R.FileName.Length+1;
1157 if R.FileName.Length > S.Length then goto 99;
1158 R.FileName.Value[R.FileName.Length] := S.Value[Len];
1160 if Len > S.Length then goto 99;
1163 if Len > S.Length then goto 99;
1166 if S.Value[Len] = '(' then
1168 Len := Len+1; SDTrefSkipSpaces;
1169 if Len > S.Length then goto 99;
1171 while not EndFound and (Len <= S.Length) do
1172 if S.Value[Len] in [',', ')', '(', ' ', chr(9)] then
1176 R.PageName.Length := R.PageName.Length+1;
1177 if R.PageName.Length > NameStringLength then goto 99;
1178 R.PageName.Value[R.PageName.Length] := S.Value[Len];
1180 if Len > S.Length then goto 99;
1183 if Len > S.Length then goto 99;
1184 if S.Value[Len] <> ')' then goto 99;
1185 Len := Len+1; SDTrefSkipSpaces;
1186 if Len > S.Length then goto 99;
1188 if SDTrefIsEnd then begin ErrorFound := false; goto 99; end;
1190 if S.Value[Len] <> ',' then goto 99;
1191 Len := Len+1; SDTrefSkipSpaces;
1192 if Len > S.Length then goto 99;
1195 R.ObjectId := SDTrefGetInteger;
1197 if Len > S.Length then goto 99;
1199 (* Object_Coordinates *)
1200 if S.Value[Len] = '(' then
1202 Len := Len+1; SDTrefSkipSpaces;
1203 if Len > S.Length then goto 99;
1204 R.XCoord := SDTrefGetInteger;
1206 if Len > S.Length then goto 99;
1207 if S.Value[Len] <> ',' then goto 99;
1208 Len := Len+1; SDTrefSkipSpaces;
1209 if Len > S.Length then goto 99;
1210 R.YCoord := SDTrefGetInteger;
1212 if Len > S.Length then goto 99;
1213 if S.Value[Len] <> ')' then goto 99;
1214 Len := Len+1; SDTrefSkipSpaces;
1215 if Len > S.Length then goto 99;
1217 if SDTrefIsEnd then begin ErrorFound := false; goto 99; end;
1219 if S.Value[Len] <> ',' then goto 99;
1220 Len := Len+1; SDTrefSkipSpaces;
1221 if Len > S.Length then goto 99;
1224 R.LineNumber := SDTrefGetInteger;
1226 if Len > S.Length then goto 99;
1227 if SDTrefIsEnd then begin ErrorFound := false; goto 99; end;
1229 if S.Value[Len] <> ',' then goto 99;
1230 Len := Len+1; SDTrefSkipSpaces;
1231 if Len > S.Length then goto 99;
1234 R.Column := SDTrefGetInteger;
1236 if Len > S.Length then goto 99;
1237 if SDTrefIsEnd then ErrorFound := false;
1240 else if S.Value[9] = 'T' then
1244 if S.Value[10] <> 'E' then goto 99;
1246 if S.Value[11] <> 'X' then goto 99;
1248 if S.Value[12] <> 'T' then goto 99;
1249 Len := 13; SDTrefSkipSpaces;
1250 if Len > S.Length then goto 99;
1253 if S.Value[Len] <> ',' then goto 99;
1254 Len := Len+1; SDTrefSkipSpaces;
1255 if Len > S.Length then goto 99;
1259 while not EndFound and (Len <= S.Length) do
1260 if S.Value[Len] in [',', ')', '(', ' ', chr(9)] then
1264 R.FileName.Length := R.FileName.Length+1;
1265 if R.FileName.Length > S.Length then goto 99;
1266 R.FileName.Value[R.FileName.Length] := S.Value[Len];
1268 if Len > S.Length then goto 99;
1271 if Len > S.Length then goto 99;
1272 if SDTrefIsEnd then begin ErrorFound := false; goto 99; end;
1274 if S.Value[Len] <> ',' then goto 99;
1275 Len := Len+1; SDTrefSkipSpaces;
1276 if Len > S.Length then goto 99;
1279 R.LineNumber := SDTrefGetInteger;
1281 if Len > S.Length then goto 99;
1282 if SDTrefIsEnd then begin ErrorFound := false; goto 99; end;
1284 if S.Value[Len] <> ',' then goto 99;
1285 Len := Len+1; SDTrefSkipSpaces;
1286 if Len > S.Length then goto 99;
1289 R.Column := SDTrefGetInteger;
1291 if Len > S.Length then goto 99;
1292 if SDTrefIsEnd then ErrorFound := false;
1303 procedure SDTrefRecToString (* (
1305 var S : SDTrefString) *) ;
1307 (* Converts SDTrefRec R to a string S (SDTrefString). If an error is
1308 detected (string is not long enough) S.Length becomes 0 on exit *)
1326 Temp.Value[1] := 'S';
1327 Temp.Value[2] := 'D';
1328 Temp.Value[3] := 'L';
1329 Temp.Value[4] := ',';
1331 S := Concatenatenamestrings(S, Temp);
1334 for I := 1 to R.FileName.Length do
1337 if Len > SDTrefStringLength then goto 99;
1338 S.Value[Len] := R.FileName.Value[I];
1342 if R.PageName.Length > 0 then
1345 if Len > SDTrefStringLength then goto 99;
1346 S.Value[Len] := '(';
1347 for I := 1 to R.PageName.Length do
1350 if Len > SDTrefStringLength then goto 99;
1351 S.Value[Len] := R.PageName.Value[I];
1354 if Len > SDTrefStringLength then goto 99;
1355 S.Value[Len] := ')';
1359 if R.ObjectId <> SDTrefUndefInt then
1362 if Len > SDTrefStringLength then goto 99;
1363 S.Value[Len] := ',';
1364 Temp := integertonmstr(R.ObjectId);
1365 for I := 1 to Temp.Length do
1368 if Len > SDTrefStringLength then goto 99;
1369 S.Value[Len] := Temp.Value[I];
1373 (* Object_Coordinates *)
1374 if R.XCoord <> SDTrefUndefInt then
1377 if Len > SDTrefStringLength then goto 99;
1378 S.Value[Len] := '(';
1379 Temp := integertonmstr(R.XCoord);
1380 for I := 1 to Temp.Length do
1383 if Len > SDTrefStringLength then goto 99;
1384 S.Value[Len] := Temp.Value[I];
1387 if Len > SDTrefStringLength then goto 99;
1388 S.Value[Len] := ',';
1389 Temp := integertonmstr(R.YCoord);
1390 for I := 1 to Temp.Length do
1393 if Len > SDTrefStringLength then goto 99;
1394 S.Value[Len] := Temp.Value[I];
1397 if Len > SDTrefStringLength then goto 99;
1398 S.Value[Len] := ')';
1402 if R.LineNumber <> SDTrefUndefInt then
1405 if Len > SDTrefStringLength then goto 99;
1406 S.Value[Len] := ',';
1407 Temp := integertonmstr(R.LineNumber);
1408 for I := 1 to Temp.Length do
1411 if Len > SDTrefStringLength then goto 99;
1412 S.Value[Len] := Temp.Value[I];
1417 if R.Column <> SDTrefUndefInt then
1420 if Len > SDTrefStringLength then goto 99;
1421 S.Value[Len] := ',';
1422 Temp := integertonmstr(R.Column);
1423 for I := 1 to Temp.Length do
1426 if Len > SDTrefStringLength then goto 99;
1427 S.Value[Len] := Temp.Value[I];
1432 if Len > SDTrefStringLength then goto 99;
1433 S.Value[Len] := ')';
1439 Temp.Value[1] := 'T';
1440 Temp.Value[2] := 'E';
1441 Temp.Value[3] := 'X';
1442 Temp.Value[4] := 'T';
1443 Temp.Value[5] := ',';
1445 S := Concatenatenamestrings(S, Temp);
1448 for I := 1 to R.FileName.Length do
1451 if Len > SDTrefStringLength then goto 99;
1452 S.Value[Len] := R.FileName.Value[I];
1456 if R.LineNumber <> SDTrefUndefInt then
1459 if Len > SDTrefStringLength then goto 99;
1460 S.Value[Len] := ',';
1461 Temp := integertonmstr(R.LineNumber);
1462 for I := 1 to Temp.Length do
1465 if Len > SDTrefStringLength then goto 99;
1466 S.Value[Len] := Temp.Value[I];
1471 if R.Column <> SDTrefUndefInt then
1474 if Len > SDTrefStringLength then goto 99;
1475 S.Value[Len] := ',';
1476 Temp := integertonmstr(R.Column);
1477 for I := 1 to Temp.Length do
1480 if Len > SDTrefStringLength then goto 99;
1481 S.Value[Len] := Temp.Value[I];
1486 if Len > SDTrefStringLength then goto 99;
1487 S.Value[Len] := ')';
1491 if Len > SDTrefStringLength then
1497 function NmStrToErrStr;(*(
1498 NmStr : NameString) : ErrorString;*)
1500 ErrStr : ErrorString;
1503 for i := 1 to NmStr.Length do
1504 ErrStr.Value[i] := NmStr.Value[i];
1505 ErrStr.Length := NmStr.Length;
1506 NmStrToErrStr := ErrStr;
1509 function ErrStrToNmStr;(*(
1510 ErrStr : ErrorString) : NameString;*)
1516 if ErrStr.Length < NameStringLength then
1519 n := NameStringLength;
1521 NmStr.Value[i] := ErrStr.Value[i];
1523 ErrStrToNmStr := NmStr;
1526 (*------------------------------------------------------------------*)
1528 (*------------------------------------------------------------------*)
1529 function GetTextRef;(*(
1532 Col : integer) : NameString;*)
1536 begin(* GetTextRef *)
1537 Ref.IsSDTGR := false;
1538 Ref.FileName := FNm;
1539 Ref.LineNumber := Ln;
1541 SDTrefRecToString(Ref, S);
1543 end; (* GetTextRef *)