rstconv.pp 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by Sebastian Guenther
  4. Added .rc and OS/2 MSG support in 2002 by Yuri Prokushev
  5. .rst resource string table file converter.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$MODE objfpc}
  13. {$H+}
  14. program rstconv;
  15. uses sysutils, classes;
  16. resourcestring
  17. help =
  18. 'rstconv [-h|--help] Displays this help'+LineEnding+
  19. 'rstconv options Convert rst file'+LineEnding+LineEnding+
  20. 'Options are:'+LineEnding+
  21. ' -i file Use specified file instead of stdin as input .rst (OPTIONAL)'+LineEnding+
  22. ' -o file Write output to specified file (REQUIRED)'+LineEnding+
  23. ' -f format Specifies the output format:'+LineEnding+
  24. ' po GNU gettext .po (portable) format (DEFAULT)'+LineEnding+
  25. ' msg IBM OS/2 MSG file format'+LineEnding+
  26. ' rc Resource compiler .rc format'+LineEnding+LineEnding+
  27. 'OS/2 MSG file only options are:'+LineEnding+
  28. ' -c identifier Specifies the component identifier (REQUIRED).'+LineEnding+
  29. ' Identifier is any three chars in upper case.'+LineEnding+
  30. ' -n number Specifies the first message number [1-9999] (OPTIONAL).'+LineEnding+LineEnding+
  31. 'Resource compiler script only options are:'+LineEnding+
  32. ' -s Use STRINGTABLE instead of MESSAGETABLE'+LineEnding+
  33. ' -c identifier Use identifier as ID base (ID+n) (OPTIONAL)'+LineEnding+
  34. ' -n number Specifies the first ID number (OPTIONAL)'+LineEnding;
  35. InvalidOption = 'Invalid option - ';
  36. RequiredOption = 'Required option is absent - ';
  37. OptionAlreadySpecified = 'Option has already been specified - ';
  38. NoOutFilename = 'No output filename specified';
  39. InvalidOutputFormat = 'Invalid output format -';
  40. MessageNumberTooBig = 'Message number too big';
  41. InvalidRange = 'Invalid range of the first message number';
  42. type
  43. TConstItem = class(TCollectionItem)
  44. public
  45. ModuleName, ConstName, Value: String;
  46. end;
  47. var
  48. InFilename, OutFilename: String;
  49. ConstItems: TCollection;
  50. Identifier: String;
  51. FirstMessage: Word;
  52. MessageTable: Boolean;
  53. procedure ReadRSTFile;
  54. var
  55. f: Text;
  56. s: String;
  57. item: TConstItem;
  58. DotPos, EqPos, i, j: Integer;
  59. begin
  60. Assign(f, InFilename);
  61. Reset(f);
  62. while not eof(f) do begin
  63. ReadLn(f, s);
  64. If (Length(S)=0) or (S[1]='#') then
  65. continue;
  66. item := TConstItem(ConstItems.Add);
  67. DotPos := Pos('.', s);
  68. EqPos := Pos('=', s);
  69. if DotPos > EqPos then // paranoia checking.
  70. DotPos := 0;
  71. item.ModuleName := Copy(s, 1, DotPos - 1);
  72. item.ConstName := Copy(s, DotPos + 1, EqPos - DotPos - 1);
  73. item.Value := '';
  74. i := EqPos + 1;
  75. while i <= Length(s) do begin
  76. if s[i] = '''' then begin
  77. Inc(i);
  78. j := i;
  79. while (i <= Length(s)) and (s[i] <> '''') do
  80. Inc(i);
  81. item.Value := item.Value + Copy(s, j, i - j);
  82. Inc(i);
  83. end else if s[i] = '#' then begin
  84. Inc(i);
  85. j := i;
  86. while (i <= Length(s)) and (s[i] in ['0'..'9']) do
  87. Inc(i);
  88. item.Value := item.Value + Chr(StrToInt(Copy(s, j, i - j)));
  89. end else if s[i] = '+' then begin
  90. ReadLn(f, s);
  91. i := 1;
  92. end else
  93. Inc(i);
  94. end;
  95. end;
  96. Close(f);
  97. end;
  98. procedure ConvertToGettextPO;
  99. var
  100. i, j: Integer;
  101. f: Text;
  102. item: TConstItem;
  103. s: String;
  104. c: Char;
  105. begin
  106. Assign(f, OutFilename);
  107. Rewrite(f);
  108. for i := 0 to ConstItems.Count - 1 do begin
  109. item := TConstItem(ConstItems.items[i]);
  110. // Convert string to C-style syntax
  111. s := '';
  112. for j := 1 to Length(item.Value) do begin
  113. c := item.Value[j];
  114. case c of
  115. #9: s := s + '\t';
  116. #10: s := s + '\n';
  117. {$IFNDEF UNIX}
  118. #13: ;
  119. #1..#8, #11..#12, #14..#31, #128..#255:
  120. {$ELSE}
  121. #1..#8, #11..#31, #128..#255:
  122. {$ENDIF}
  123. s := s + '\' +
  124. Chr(Ord(c) shr 6 + 48) +
  125. Chr((Ord(c) shr 3) and 7 + 48) +
  126. Chr(Ord(c) and 7 + 48);
  127. '\': s := s + '\\';
  128. '"': s := s + '\"';
  129. else s := s + c;
  130. end;
  131. end;
  132. // Write msg entry
  133. WriteLn(f, '#: ', item.ModuleName, ':', item.ConstName);
  134. WriteLn(f, 'msgid "', s, '"');
  135. WriteLn(f, 'msgstr ""');
  136. WriteLn(f);
  137. end;
  138. Close(f);
  139. end;
  140. // This routine stores rst file in rc format. Can be written as MESSAGETABLE
  141. // as STRINGTABLE. Beware! OS/2 RC doesn't support lines longer whan 255 chars.
  142. procedure ConvertToRC;
  143. var
  144. i, j: Integer;
  145. f: Text;
  146. item: TConstItem;
  147. s: String;
  148. c: Char;
  149. begin
  150. Assign(f, OutFilename);
  151. Rewrite(f);
  152. If MessageTable then
  153. WriteLn(F, 'MESSAGETABLE')
  154. else
  155. WriteLn(F, 'STRINGTABLE');
  156. WriteLn(F, 'BEGIN');
  157. If Identifier<>'' then WriteLn(F, '#define ', Identifier);
  158. for i := 0 to ConstItems.Count - 1 do begin
  159. item := TConstItem(ConstItems.items[i]);
  160. // Convert string to C-style syntax
  161. s := '';
  162. for j := 1 to Length(item.Value) do begin
  163. c := item.Value[j];
  164. case c of
  165. #9: s := s + '\t';
  166. #10: s := s + '\n"'#13#10'"';
  167. {$IFNDEF UNIX}
  168. #13: ;
  169. #1..#8, #11..#12, #14..#31, #128..#255:
  170. {$ELSE}
  171. #1..#8, #11..#31, #128..#255:
  172. {$ENDIF}
  173. s := s + '\' +
  174. Chr(Ord(c) shr 6 + 48) +
  175. Chr((Ord(c) shr 3) and 7 + 48) +
  176. Chr(Ord(c) and 7 + 48);
  177. '\': s := s + '\\';
  178. '"': s := s + '\"';
  179. else s := s + c;
  180. end;
  181. end;
  182. // Write msg entry
  183. WriteLn(f, '/* ', item.ModuleName, ':', item.ConstName, '*/');
  184. WriteLn(f, '/* ', s, ' */');
  185. If Identifier<>'' then Write(F, Identifier, '+');
  186. WriteLn(f, I+FirstMessage,' "', s, '"');
  187. WriteLn(f);
  188. end;
  189. WriteLn(F, 'END');
  190. Close(f);
  191. end;
  192. // This routine stores rst file in OS/2 msg format. This format is preffered
  193. // for help screens, messages, etc.
  194. procedure ConvertToOS2MSG;
  195. var
  196. i, j: Integer;
  197. f: Text;
  198. item: TConstItem;
  199. s: String;
  200. begin
  201. If (ConstItems.Count+FirstMessage-1)>9999 then
  202. begin
  203. WriteLn(MessageNumberTooBig);
  204. Halt(1);
  205. end;
  206. Identifier:=Copy(UpperCase(Identifier), 1, 3);
  207. Assign(f, OutFilename);
  208. Rewrite(f);
  209. WriteLn(f, Identifier);
  210. // Fake entry, because MKMSGF limitation
  211. WriteLn(f, Format('%s%.4d?: ',[Identifier, FirstMessage-1]));
  212. for i := 0 to ConstItems.Count - 1 do begin
  213. item := TConstItem(ConstItems.items[i]);
  214. // Prepare comment string
  215. // Convert string to C-style syntax
  216. s := '';
  217. j:=1;
  218. while j<=Length(item.Value) do
  219. begin
  220. if copy(item.Value, j, 2)=#13#10 then
  221. begin
  222. s:=s+#13#10';';
  223. Inc(j, 2);
  224. end else begin
  225. s := s + item.Value[j];
  226. Inc(j);
  227. end;
  228. end;
  229. // Write msg entry
  230. WriteLn(f, ';', item.ModuleName, '.', item.ConstName);
  231. WriteLn(f, Format(';%s%.4dP: %s %%0',[Identifier, i+FirstMessage, s]));
  232. WriteLn(f, Format('%s%.4dP: %s %%0',[Identifier, i+FirstMessage, Item.Value]));
  233. end;
  234. Close(f);
  235. end;
  236. type
  237. TConversionProc = procedure;
  238. var
  239. i: Integer;
  240. ConversionProc: TConversionProc;
  241. OutputFormat: String;
  242. begin
  243. if (ParamStr(1) = '-h') or (ParamStr(1) = '--help') then begin
  244. WriteLn(help);
  245. exit;
  246. end;
  247. ConversionProc := @ConvertToGettextPO;
  248. OutputFormat:='';
  249. Identifier:='';
  250. FirstMessage:=0;
  251. MessageTable:=True;
  252. i := 1;
  253. while i <= ParamCount do begin
  254. if ParamStr(i) = '-i' then begin
  255. if InFilename <> '' then begin
  256. WriteLn(StdErr, OptionAlreadySpecified, '-i');
  257. Halt(1);
  258. end;
  259. InFilename := ParamStr(i + 1);
  260. Inc(i, 2);
  261. end else if ParamStr(i) = '-o' then begin
  262. if OutFilename <> '' then begin
  263. WriteLn(StdErr, OptionAlreadySpecified, '-o');
  264. Halt(1);
  265. end;
  266. OutFilename := ParamStr(i + 1);
  267. Inc(i, 2);
  268. end else if ParamStr(i) = '-f' then begin
  269. if OutputFormat <> '' then begin
  270. WriteLn(StdErr, OptionAlreadySpecified, '-f');
  271. Halt(1);
  272. end;
  273. if ParamStr(i + 1) = 'po' then
  274. OutputFormat:='po'
  275. else if ParamStr(i + 1) = 'msg' then begin
  276. OutputFormat:='msg';
  277. ConversionProc := @ConvertToOS2MSG;
  278. end else if ParamStr(i + 1) = 'rc' then begin
  279. OutputFormat:='rc';
  280. ConversionProc := @ConvertToRC;
  281. end else begin
  282. WriteLn(StdErr, InvalidOutputFormat, ParamStr(i + 1));
  283. Halt(1);
  284. end;
  285. Inc(i, 2);
  286. end else if ParamStr(i) = '-c' then begin
  287. if Identifier <> '' then begin
  288. WriteLn(StdErr, OptionAlreadySpecified, '-c');
  289. Halt(1);
  290. end;
  291. Identifier:=ParamStr(i+1);
  292. Inc(i, 2);
  293. end else if ParamStr(i) = '-s' then begin
  294. if not MessageTable then begin
  295. WriteLn(StdErr, OptionAlreadySpecified, '-s');
  296. Halt(1);
  297. end;
  298. MessageTable:=False;
  299. Inc(i);
  300. end else if ParamStr(i) = '-n' then begin
  301. if FirstMessage <> 0 then begin
  302. WriteLn(StdErr, OptionAlreadySpecified, '-n');
  303. Halt(1);
  304. end;
  305. try
  306. FirstMessage := StrToInt(ParamStr(i + 1));
  307. If (FirstMessage<1) then raise EConvertError.Create(InvalidRange+' '+ParamStr(i+1));
  308. except
  309. on EConvertError do
  310. begin
  311. WriteLn(StdErr, InvalidOption, ParamStr(i));
  312. Halt(1);
  313. end;
  314. end;
  315. Inc(i, 2);
  316. end else begin
  317. WriteLn(StdErr, InvalidOption, ParamStr(i));
  318. Halt(1);
  319. end;
  320. end;
  321. If ((OutputFormat<>'msg') and (OutputFormat<>'rc')) and ((Identifier<>'') or (FirstMessage<>0)) then begin
  322. WriteLn(StdErr, InvalidOption, '');
  323. Halt(1);
  324. end;
  325. If (OutputFormat='msg') and (Identifier='') then begin
  326. WriteLn(StdErr, RequiredOption, '-c');
  327. Halt(1);
  328. end;
  329. if OutFilename = '' then begin
  330. WriteLn(StdErr, NoOutFilename);
  331. Halt(1);
  332. end;
  333. ConstItems := TCollection.Create(TConstItem);
  334. ReadRSTFile;
  335. ConversionProc;
  336. end.