widestr.pas 4.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187
  1. {
  2. $Id$
  3. Copyright (c) 2000 by Florian Klaempfl
  4. This unit contains basic functions for unicode support in the
  5. compiler, this unit is mainly necessary to bootstrap widestring
  6. support ...
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or
  10. (at your option) any later version.
  11. This program is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. GNU General Public License for more details.
  15. You should have received a copy of the GNU General Public License
  16. along with this program; if not, write to the Free Software
  17. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18. ****************************************************************************
  19. }
  20. unit widestr;
  21. interface
  22. { uses
  23. charset;
  24. }
  25. type
  26. tcompilerwidechar = word;
  27. pcompilerwidechar = ^tcompilerwidechar;
  28. pcompilerwidestring = ^tcompilerwidestring;
  29. tcompilerwidestring = record
  30. data : pcompilerwidechar;
  31. maxlen,len : longint;
  32. end;
  33. procedure initwidestring(var r : tcompilerwidestring);
  34. procedure donewidestring(var r : tcompilerwidestring);
  35. procedure setlengthwidestring(var r : tcompilerwidestring;l : longint);
  36. function getlengthwidestring(const r : tcompilerwidestring) : longint;
  37. procedure concatwidestringchar(var r : tcompilerwidestring;c : tcompilerwidechar);
  38. procedure concatwidestringwidestring(const s1,s2 : tcompilerwidestring;
  39. var r : tcompilerwidestring);
  40. procedure copywidestring(const s : tcompilerwidestring;var d : tcompilerwidestring);
  41. function asciichar2unicode(c : char) : tcompilerwidechar;
  42. procedure ascii2unicode(const s : string;var r : tcompilerwidestring);
  43. function getcharwidestring(const r : tcompilerwidestring;l : longint) : tcompilerwidechar;
  44. function cpavailable(const s : string) : boolean;
  45. implementation
  46. { uses
  47. i8869_1,cp850,cp437; }
  48. uses
  49. globals;
  50. procedure initwidestring(var r : tcompilerwidestring);
  51. begin
  52. r.data:=nil;
  53. r.len:=0;
  54. r.maxlen:=0;
  55. end;
  56. procedure donewidestring(var r : tcompilerwidestring);
  57. begin
  58. if assigned(r.data) then
  59. freemem(r.data);
  60. r.data:=nil;
  61. r.maxlen:=0;
  62. r.len:=0;
  63. end;
  64. function getcharwidestring(const r : tcompilerwidestring;l : longint) : tcompilerwidechar;
  65. begin
  66. getcharwidestring:=r.data[l];
  67. end;
  68. function getlengthwidestring(const r : tcompilerwidestring) : longint;
  69. begin
  70. getlengthwidestring:=r.len;
  71. end;
  72. procedure setlengthwidestring(var r : tcompilerwidestring;l : longint);
  73. begin
  74. if r.maxlen>=l then
  75. exit;
  76. if assigned(r.data) then
  77. reallocmem(r.data,sizeof(tcompilerwidechar)*l)
  78. else
  79. getmem(r.data,sizeof(tcompilerwidechar)*l);
  80. end;
  81. procedure concatwidestringchar(var r : tcompilerwidestring;c : tcompilerwidechar);
  82. begin
  83. if r.len>=r.maxlen then
  84. setlengthwidestring(r,r.len+16);
  85. r.data[r.len]:=c;
  86. inc(r.len);
  87. end;
  88. procedure concatwidestringwidestring(const s1,s2 : tcompilerwidestring;
  89. var r : tcompilerwidestring);
  90. begin
  91. setlengthwidestring(r,s1.len+s2.len);
  92. r.len:=s1.len+s2.len;
  93. move(s1.data^,r.data^,s1.len);
  94. move(s2.data^,r.data[s1.len],s2.len);
  95. end;
  96. function comparewidestringwidestring(const s1,s2 : tcompilerwidestring) : longint;
  97. begin
  98. { !!!! }
  99. end;
  100. procedure copywidestring(const s : tcompilerwidestring;var d : tcompilerwidestring);
  101. begin
  102. setlengthwidestring(d,s.len);
  103. d.len:=s.len;
  104. move(s.data^,d.data^,s.len);
  105. end;
  106. function asciichar2unicode(c : char) : tcompilerwidechar;
  107. {!!!!!!!!
  108. var
  109. m : punicodemap;
  110. begin
  111. m:=getmap(aktsourcecodepage);
  112. asciichar2unicode:=getunicode(c,m);
  113. end;
  114. }
  115. begin
  116. end;
  117. procedure ascii2unicode(const s : string;var r : tcompilerwidestring);
  118. {!!!!!!
  119. var
  120. m : punicodemap;
  121. i : longint;
  122. begin
  123. m:=getmap(aktsourcecodepage);
  124. { should be a very good estimation :) }
  125. setlengthwidestring(r,length(s));
  126. // !!!! MBCS
  127. for i:=1 to length(s) do
  128. begin
  129. end;
  130. end;
  131. }
  132. begin
  133. end;
  134. function cpavailable(const s : string) : boolean;
  135. {!!!!!!
  136. begin
  137. cpavailable:=mappingavailable(s);
  138. end;
  139. }
  140. begin
  141. end;
  142. end.
  143. {
  144. $Log$
  145. Revision 1.1 2000-11-29 00:30:43 florian
  146. * unused units removed from uses clause
  147. * some changes for widestrings
  148. }