diff --git a/.gitattributes b/.gitattributes index bfcd9bca4c..a698480353 100644 --- a/.gitattributes +++ b/.gitattributes @@ -4120,6 +4120,11 @@ packages/fcl-res/src/machosubreader.inc svneol=native#text/plain packages/fcl-res/src/machosubwriter.inc svneol=native#text/plain packages/fcl-res/src/machotypes.pp svneol=native#text/plain packages/fcl-res/src/machowriter.pp svneol=native#text/plain +packages/fcl-res/src/rclex.inc svneol=native#text/plain +packages/fcl-res/src/rclex.l svneol=native#text/plain +packages/fcl-res/src/rcparser.pas svneol=native#text/pascal +packages/fcl-res/src/rcparser.y svneol=native#text/plain +packages/fcl-res/src/rcreader.pp svneol=native#text/pascal packages/fcl-res/src/resdatastream.pp svneol=native#text/plain packages/fcl-res/src/resfactory.pp svneol=native#text/plain packages/fcl-res/src/resmerger.pp svneol=native#text/plain @@ -4135,6 +4140,8 @@ packages/fcl-res/src/versionresource.pp svneol=native#text/plain packages/fcl-res/src/versiontypes.pp svneol=native#text/plain packages/fcl-res/src/winpeimagereader.pp svneol=native#text/plain packages/fcl-res/src/xcoffwriter.pp svneol=native#text/plain +packages/fcl-res/src/yyinclude.pp svneol=native#text/pascal +packages/fcl-res/src/yypreproc.pp svneol=native#text/pascal packages/fcl-res/xml/acceleratorsresource.xml svneol=native#text/plain packages/fcl-res/xml/bitmapresource.xml svneol=native#text/plain packages/fcl-res/xml/clean.sh svneol=native#text/plain diff --git a/packages/fcl-res/src/rclex.inc b/packages/fcl-res/src/rclex.inc new file mode 100644 index 0000000000..b3b506c8cc --- /dev/null +++ b/packages/fcl-res/src/rclex.inc @@ -0,0 +1,400 @@ + +(* lexical analyzer template (TP Lex V3.0), V1.0 3-2-91 AG *) + +(* global definitions: *) + +const INCOMLINE = 2; +const INCOMMENT = 4; +const INSTRING = 6; + + + +function yylex : Integer; + +procedure yyaction ( yyruleno : Integer ); + (* local definitions: *) + +begin + (* actions: *) + case yyruleno of + 1: + start(INCOMLINE); + 2: + begin start(0); unget_char(nl); end; + 3: + yymore; + + 4: + start(INCOMMENT); + 5: + ; + 6: + start(0); + 7: + return(ILLEGAL); + + 8: + begin + if ypreproc.isdefine(yytext) then begin + unget_char(' '); + unget_string(ypreproc.getdefine(yytext)); + end else + return(ID); + end; + 9: + return(ID); +(* +[ \t\n\f] ; +#define +#else +#endif +#ifdef +#ifndef +#include +#undef + +. begin + writeln(erroutput, 'Illegal character in line ',yylineno, ' col ', yycolno); + writeln(erroutput, '"',yyline,'"'); + return(ILLEGAL); + end; +*) + end; +end(*yyaction*); + +(* DFA table: *) + +type YYTRec = record + cc : set of Char; + s : Integer; + end; + +const + +yynmarks = 13; +yynmatches = 13; +yyntrans = 21; +yynstates = 20; + +yyk : array [1..yynmarks] of Integer = ( + { 0: } + { 1: } + { 2: } + { 3: } + { 4: } + { 5: } + { 6: } + { 7: } + { 8: } + 9, + { 9: } + 8, + 9, + { 10: } + 9, + { 11: } + 2, + { 12: } + 3, + { 13: } + 5, + { 14: } + 5, + { 15: } + 7, + { 16: } + 1, + { 17: } + 4, + { 18: } + 8, + { 19: } + 6 +); + +yym : array [1..yynmatches] of Integer = ( +{ 0: } +{ 1: } +{ 2: } +{ 3: } +{ 4: } +{ 5: } +{ 6: } +{ 7: } +{ 8: } + 9, +{ 9: } + 8, + 9, +{ 10: } + 9, +{ 11: } + 2, +{ 12: } + 3, +{ 13: } + 5, +{ 14: } + 5, +{ 15: } + 7, +{ 16: } + 1, +{ 17: } + 4, +{ 18: } + 8, +{ 19: } + 6 +); + +yyt : array [1..yyntrans] of YYTrec = ( +{ 0: } + ( cc: [ #1..#9,#11..'.','0'..'@','['..'^','`','{'..#255 ]; s: 10), + ( cc: [ '/' ]; s: 8), + ( cc: [ 'A'..'Z','_','a'..'z' ]; s: 9), +{ 1: } + ( cc: [ #1..#9,#11..'.','0'..'@','['..'^','`','{'..#255 ]; s: 10), + ( cc: [ '/' ]; s: 8), + ( cc: [ 'A'..'Z','_','a'..'z' ]; s: 9), +{ 2: } + ( cc: [ #1..#9,#11..#255 ]; s: 12), + ( cc: [ #10 ]; s: 11), +{ 3: } + ( cc: [ #1..#9,#11..#255 ]; s: 12), + ( cc: [ #10 ]; s: 11), +{ 4: } + ( cc: [ #0 ]; s: 15), + ( cc: [ #1..#9,#11..')','+'..#255 ]; s: 13), + ( cc: [ '*' ]; s: 14), +{ 5: } + ( cc: [ #0 ]; s: 15), + ( cc: [ #1..#9,#11..')','+'..#255 ]; s: 13), + ( cc: [ '*' ]; s: 14), +{ 6: } +{ 7: } +{ 8: } + ( cc: [ '*' ]; s: 17), + ( cc: [ '/' ]; s: 16), +{ 9: } + ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 18), +{ 10: } +{ 11: } +{ 12: } +{ 13: } +{ 14: } + ( cc: [ '/' ]; s: 19), +{ 15: } +{ 16: } +{ 17: } +{ 18: } + ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 18) +{ 19: } +); + +yykl : array [0..yynstates-1] of Integer = ( +{ 0: } 1, +{ 1: } 1, +{ 2: } 1, +{ 3: } 1, +{ 4: } 1, +{ 5: } 1, +{ 6: } 1, +{ 7: } 1, +{ 8: } 1, +{ 9: } 2, +{ 10: } 4, +{ 11: } 5, +{ 12: } 6, +{ 13: } 7, +{ 14: } 8, +{ 15: } 9, +{ 16: } 10, +{ 17: } 11, +{ 18: } 12, +{ 19: } 13 +); + +yykh : array [0..yynstates-1] of Integer = ( +{ 0: } 0, +{ 1: } 0, +{ 2: } 0, +{ 3: } 0, +{ 4: } 0, +{ 5: } 0, +{ 6: } 0, +{ 7: } 0, +{ 8: } 1, +{ 9: } 3, +{ 10: } 4, +{ 11: } 5, +{ 12: } 6, +{ 13: } 7, +{ 14: } 8, +{ 15: } 9, +{ 16: } 10, +{ 17: } 11, +{ 18: } 12, +{ 19: } 13 +); + +yyml : array [0..yynstates-1] of Integer = ( +{ 0: } 1, +{ 1: } 1, +{ 2: } 1, +{ 3: } 1, +{ 4: } 1, +{ 5: } 1, +{ 6: } 1, +{ 7: } 1, +{ 8: } 1, +{ 9: } 2, +{ 10: } 4, +{ 11: } 5, +{ 12: } 6, +{ 13: } 7, +{ 14: } 8, +{ 15: } 9, +{ 16: } 10, +{ 17: } 11, +{ 18: } 12, +{ 19: } 13 +); + +yymh : array [0..yynstates-1] of Integer = ( +{ 0: } 0, +{ 1: } 0, +{ 2: } 0, +{ 3: } 0, +{ 4: } 0, +{ 5: } 0, +{ 6: } 0, +{ 7: } 0, +{ 8: } 1, +{ 9: } 3, +{ 10: } 4, +{ 11: } 5, +{ 12: } 6, +{ 13: } 7, +{ 14: } 8, +{ 15: } 9, +{ 16: } 10, +{ 17: } 11, +{ 18: } 12, +{ 19: } 13 +); + +yytl : array [0..yynstates-1] of Integer = ( +{ 0: } 1, +{ 1: } 4, +{ 2: } 7, +{ 3: } 9, +{ 4: } 11, +{ 5: } 14, +{ 6: } 17, +{ 7: } 17, +{ 8: } 17, +{ 9: } 19, +{ 10: } 20, +{ 11: } 20, +{ 12: } 20, +{ 13: } 20, +{ 14: } 20, +{ 15: } 21, +{ 16: } 21, +{ 17: } 21, +{ 18: } 21, +{ 19: } 22 +); + +yyth : array [0..yynstates-1] of Integer = ( +{ 0: } 3, +{ 1: } 6, +{ 2: } 8, +{ 3: } 10, +{ 4: } 13, +{ 5: } 16, +{ 6: } 16, +{ 7: } 16, +{ 8: } 18, +{ 9: } 19, +{ 10: } 19, +{ 11: } 19, +{ 12: } 19, +{ 13: } 19, +{ 14: } 20, +{ 15: } 20, +{ 16: } 20, +{ 17: } 20, +{ 18: } 21, +{ 19: } 21 +); + + +var yyn : Integer; + +label start, scan, action; + +begin + +start: + + (* initialize: *) + + yynew; + +scan: + + (* mark positions and matches: *) + + for yyn := yykl[yystate] to yykh[yystate] do yymark(yyk[yyn]); + for yyn := yymh[yystate] downto yyml[yystate] do yymatch(yym[yyn]); + + if yytl[yystate]>yyth[yystate] then goto action; (* dead state *) + + (* get next character: *) + + yyscan; + + (* determine action: *) + + yyn := yytl[yystate]; + while (yyn<=yyth[yystate]) and not (yyactchar in yyt[yyn].cc) do inc(yyn); + if yyn>yyth[yystate] then goto action; + (* no transition on yyactchar in this state *) + + (* switch to new state: *) + + yystate := yyt[yyn].s; + + goto scan; + +action: + + (* execute action: *) + + if yyfind(yyrule) then + begin + yyaction(yyrule); + if yyreject then goto action; + end + else if not yydefault and yywrap() then + begin + yyclear; + return(0); + end; + + if not yydone then goto start; + + yylex := yyretval; + +end(*yylex*); + + + +// end. + + + + + diff --git a/packages/fcl-res/src/rclex.l b/packages/fcl-res/src/rclex.l new file mode 100644 index 0000000000..df206b630f --- /dev/null +++ b/packages/fcl-res/src/rclex.l @@ -0,0 +1,51 @@ + +%x INCOMLINE INCOMMENT INSTRING + +D [0-9] +H [0-9a-fA-F] + +%% + +"//" start(INCOMLINE); +\n begin start(0); unget_char(nl); end; +. yymore; + +"/*" start(INCOMMENT); +. ; +"*/" start(0); +\0 return(ILLEGAL); + +[a-zA-Z_]([a-zA-Z0-9_])* begin + if ypreproc.isdefine(yytext) then begin + unget_char(' '); + unget_string(ypreproc.getdefine(yytext)); + end else + return(ID); + end; +. return(ID); +%{ +(* +[ \t\n\f] ; +#define +#else +#endif +#ifdef +#ifndef +#include +#undef + +. begin + writeln(erroutput, 'Illegal character in line ',yylineno, ' col ', yycolno); + writeln(erroutput, '"',yyline,'"'); + return(ILLEGAL); + end; +*) +%} +%% + +// end. + + + + + diff --git a/packages/fcl-res/src/rcparser.pas b/packages/fcl-res/src/rcparser.pas new file mode 100644 index 0000000000..38f52e8230 --- /dev/null +++ b/packages/fcl-res/src/rcparser.pas @@ -0,0 +1,381 @@ + +(* Yacc parser template (TP Yacc V3.0), V1.2 6-17-91 AG *) + +(* global definitions: *) + +(* +Vorspann + ****************************************************************************) + +unit rcparser; + +{$modeswitch advancedrecords} + +interface + +uses + SysUtils, Classes, StrUtils, lexlib, yacclib, resource; + +function yyparse : Integer; + +var + aktresources: TResources; + opt_code_page: TSystemCodePage; + yyfilename: AnsiString; + yyparseresult: YYSType; + +procedure PragmaCodePage(cp: string); + +{$DEFINE INC_HEADER} +{$I yyinclude.pp} +{$I yypreproc.pp} +{$UNDEF INC_HEADER} + +implementation + +procedure yyerror ( msg : String ); +begin + writeln(ErrOutput, yyfilename, '(',yylineno,':',yycolno,'): at "',yytext,'"'); + WriteLn(ErrOutput, ' ',msg); +end(*yyerrmsg*); + +{$I yyinclude.pp} +{$I yypreproc.pp} + +(* I/O routines: *) + +const nl = #10; (* newline character *) + +const max_chars = 2048; + +var + bufptr : Integer; + buf : array [1..max_chars] of Char; + +function rc_get_char : Char; + var i : Integer; + ok : boolean; + begin + if (bufptr=0) and not eof(yyinput) then + begin + repeat + readln(yyinput, yyline); + inc(yylineno); yycolno := 1; + ok:= ypreproc.useline(yyline); + until (ok or eof(yyinput)); + if ok then begin + buf[1] := nl; + for i := 1 to length(yyline) do + buf[i+1] := yyline[length(yyline)-i+1]; + inc(bufptr, length(yyline)+1); + end; + end; + if bufptr>0 then + begin + rc_get_char := buf[bufptr]; + dec(bufptr); + inc(yycolno); + end + else + rc_get_char := #0; + end(*get_char*); + +procedure rc_unget_char ( c : Char ); + begin + if bufptr=max_chars then yyerror('input buffer overflow'); + inc(bufptr); + dec(yycolno); + buf[bufptr] := c; + end(*unget_char*); + +procedure unget_string(s: string); +var + i: integer; +begin + for i:= Length(s) downto 1 do + rc_unget_char(s[i]); +end; + +procedure PragmaCodePage(cp: string); +var cpi: integer; +begin + if Uppercase(cp) = 'DEFAULT' then + opt_code_page:= DefaultFileSystemCodePage + else begin + if TryStrToInt(cp, cpi) and (cpi>=0) and (cpi<=high(TSystemCodePage)) then + opt_code_page:= cpi + else + yyerror('Invalid code_page pragma: "' + cp + '"'); + end; +end; + + +var + yycapture: AnsiString; +const ILLEGAL = 257; +const CSTRING = 258; +const NUMBER = 259; +const ID = 260; +const EQUAL = 261; +const R_AND = 262; +const UNEQUAL = 263; +const GT = 264; +const LT = 265; +const GTE = 266; +const LTE = 267; +const QUESTIONMARK = 268; +const COLON = 269; + +var yylval : YYSType; + +function yylex : Integer; forward; + +function yyparse : Integer; + +var yystate, yysp, yyn : Integer; + yys : array [1..yymaxdepth] of Integer; + yyv : array [1..yymaxdepth] of YYSType; + yyval : YYSType; + +procedure yyaction ( yyruleno : Integer ); + (* local definitions: *) +begin + (* actions: *) + case yyruleno of + 1 : begin + Echo; + end; + 2 : begin + end; + end; +end(*yyaction*); + +(* parse table: *) + +type YYARec = record + sym, act : Integer; + end; + YYRRec = record + len, sym : Integer; + end; + +const + +yynacts = 2; +yyngotos = 1; +yynstates = 3; +yynrules = 2; + +yya : array [1..yynacts] of YYARec = ( +{ 0: } +{ 1: } + ( sym: 0; act: 0 ), + ( sym: 260; act: 2 ) +{ 2: } +); + +yyg : array [1..yyngotos] of YYARec = ( +{ 0: } + ( sym: -2; act: 1 ) +{ 1: } +{ 2: } +); + +yyd : array [0..yynstates-1] of Integer = ( +{ 0: } -2, +{ 1: } 0, +{ 2: } -1 +); + +yyal : array [0..yynstates-1] of Integer = ( +{ 0: } 1, +{ 1: } 1, +{ 2: } 3 +); + +yyah : array [0..yynstates-1] of Integer = ( +{ 0: } 0, +{ 1: } 2, +{ 2: } 2 +); + +yygl : array [0..yynstates-1] of Integer = ( +{ 0: } 1, +{ 1: } 2, +{ 2: } 2 +); + +yygh : array [0..yynstates-1] of Integer = ( +{ 0: } 1, +{ 1: } 1, +{ 2: } 1 +); + +yyr : array [1..yynrules] of YYRRec = ( +{ 1: } ( len: 2; sym: -2 ), +{ 2: } ( len: 0; sym: -2 ) +); + + +const _error = 256; (* error token *) + +function yyact(state, sym : Integer; var act : Integer) : Boolean; + (* search action table *) + var k : Integer; + begin + k := yyal[state]; + while (k<=yyah[state]) and (yya[k].sym<>sym) do inc(k); + if k>yyah[state] then + yyact := false + else + begin + act := yya[k].act; + yyact := true; + end; + end(*yyact*); + +function yygoto(state, sym : Integer; var nstate : Integer) : Boolean; + (* search goto table *) + var k : Integer; + begin + k := yygl[state]; + while (k<=yygh[state]) and (yyg[k].sym<>sym) do inc(k); + if k>yygh[state] then + yygoto := false + else + begin + nstate := yyg[k].act; + yygoto := true; + end; + end(*yygoto*); + +label parse, next, error, errlab, shift, reduce, accept, abort; + +begin(*yyparse*) + + (* initialize: *) + + yystate := 0; yychar := -1; yynerrs := 0; yyerrflag := 0; yysp := 0; + +{$ifdef yydebug} + yydebug := true; +{$else} + yydebug := false; +{$endif} + +parse: + + (* push state and value: *) + + inc(yysp); + if yysp>yymaxdepth then + begin + yyerror('yyparse stack overflow'); + goto abort; + end; + yys[yysp] := yystate; yyv[yysp] := yyval; + +next: + + if (yyd[yystate]=0) and (yychar=-1) then + (* get next symbol *) + begin + yychar := yylex; if yychar<0 then yychar := 0; + end; + + if yydebug then writeln('state ', yystate, ', char ', yychar); + + (* determine parse action: *) + + yyn := yyd[yystate]; + if yyn<>0 then goto reduce; (* simple state *) + + (* no default action; search parse table *) + + if not yyact(yystate, yychar, yyn) then goto error + else if yyn>0 then goto shift + else if yyn<0 then goto reduce + else goto accept; + +error: + + (* error; start error recovery: *) + + if yyerrflag=0 then yyerror('syntax error'); + +errlab: + + if yyerrflag=0 then inc(yynerrs); (* new error *) + + if yyerrflag<=2 then (* incomplete recovery; try again *) + begin + yyerrflag := 3; + (* uncover a state with shift action on error token *) + while (yysp>0) and not ( yyact(yys[yysp], _error, yyn) and + (yyn>0) ) do + begin + if yydebug then + if yysp>1 then + writeln('error recovery pops state ', yys[yysp], ', uncovers ', + yys[yysp-1]) + else + writeln('error recovery fails ... abort'); + dec(yysp); + end; + if yysp=0 then goto abort; (* parser has fallen from stack; abort *) + yystate := yyn; (* simulate shift on error *) + goto parse; + end + else (* no shift yet; discard symbol *) + begin + if yydebug then writeln('error recovery discards char ', yychar); + if yychar=0 then goto abort; (* end of input; abort *) + yychar := -1; goto next; (* clear lookahead char and try again *) + end; + +shift: + + (* go to new state, clear lookahead character: *) + + yystate := yyn; yychar := -1; yyval := yylval; + if yyerrflag>0 then dec(yyerrflag); + + goto parse; + +reduce: + + (* execute action, pop rule from stack, and go to next state: *) + + if yydebug then writeln('reduce ', -yyn); + + yyflag := yyfnone; yyaction(-yyn); + dec(yysp, yyr[-yyn].len); + if yygoto(yys[yysp], yyr[-yyn].sym, yyn) then yystate := yyn; + + (* handle action calls to yyaccept, yyabort and yyerror: *) + + case yyflag of + yyfaccept : goto accept; + yyfabort : goto abort; + yyferror : goto errlab; + end; + + goto parse; + +accept: + + yyparse := 0; exit; + +abort: + + yyparse := 1; exit; + +end(*yyparse*); + + +{$I rclex.inc} +begin + bufptr:= 0; + lexlib.get_char:= @rc_get_char; + lexlib.unget_char:= @rc_unget_char; +end. diff --git a/packages/fcl-res/src/rcparser.y b/packages/fcl-res/src/rcparser.y new file mode 100644 index 0000000000..6e4b79a05f --- /dev/null +++ b/packages/fcl-res/src/rcparser.y @@ -0,0 +1,137 @@ +%{ +(* +Vorspann + ****************************************************************************) + +unit rcparser; + +{$modeswitch advancedrecords} + +interface + +uses + SysUtils, Classes, StrUtils, lexlib, yacclib, resource; + +function yyparse : Integer; + +var + aktresources: TResources; + opt_code_page: TSystemCodePage; + yyfilename: AnsiString; + yyparseresult: YYSType; + +procedure PragmaCodePage(cp: string); + +{$DEFINE INC_HEADER} +{$I yyinclude.pp} +{$I yypreproc.pp} +{$UNDEF INC_HEADER} + +implementation + +procedure yyerror ( msg : String ); +begin + writeln(ErrOutput, yyfilename, '(',yylineno,':',yycolno,'): at "',yytext,'"'); + WriteLn(ErrOutput, ' ',msg); +end(*yyerrmsg*); + +{$I yyinclude.pp} +{$I yypreproc.pp} + +(* I/O routines: *) + +const nl = #10; (* newline character *) + +const max_chars = 2048; + +var + bufptr : Integer; + buf : array [1..max_chars] of Char; + +function rc_get_char : Char; + var i : Integer; + ok : boolean; + begin + if (bufptr=0) and not eof(yyinput) then + begin + repeat + readln(yyinput, yyline); + inc(yylineno); yycolno := 1; + ok:= ypreproc.useline(yyline); + until (ok or eof(yyinput)); + if ok then begin + buf[1] := nl; + for i := 1 to length(yyline) do + buf[i+1] := yyline[length(yyline)-i+1]; + inc(bufptr, length(yyline)+1); + end; + end; + if bufptr>0 then + begin + rc_get_char := buf[bufptr]; + dec(bufptr); + inc(yycolno); + end + else + rc_get_char := #0; + end(*get_char*); + +procedure rc_unget_char ( c : Char ); + begin + if bufptr=max_chars then yyerror('input buffer overflow'); + inc(bufptr); + dec(yycolno); + buf[bufptr] := c; + end(*unget_char*); + +procedure unget_string(s: string); +var + i: integer; +begin + for i:= Length(s) downto 1 do + rc_unget_char(s[i]); +end; + +procedure PragmaCodePage(cp: string); +var cpi: integer; +begin + if Uppercase(cp) = 'DEFAULT' then + opt_code_page:= DefaultFileSystemCodePage + else begin + if TryStrToInt(cp, cpi) and (cpi>=0) and (cpi<=high(TSystemCodePage)) then + opt_code_page:= cpi + else + yyerror('Invalid code_page pragma: "' + cp + '"'); + end; +end; + + +var + yycapture: AnsiString; +%} + +%token ILLEGAL +%token CSTRING NUMBER +%token ID + +%right EQUAL +%right R_AND + +%left UNEQUAL GT LT GTE LTE +%left QUESTIONMARK COLON +%% + +rcfile + : rcfile ID { Echo; } + | + ; + +%% + +{$I rclex.inc} +begin + bufptr:= 0; + lexlib.get_char:= @rc_get_char; + lexlib.unget_char:= @rc_unget_char; +end. + diff --git a/packages/fcl-res/src/rcreader.pp b/packages/fcl-res/src/rcreader.pp new file mode 100644 index 0000000000..e03bdbb4f4 --- /dev/null +++ b/packages/fcl-res/src/rcreader.pp @@ -0,0 +1,119 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2008 by Giulio Bernardi + + Resource reader/compiler for MS RC script files + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +unit rcreader; + +{$MODE OBJFPC} {$H+} + +interface + +uses + Classes, SysUtils, resource; + +type + + { TRCResourceReader } + + TRCResourceReader = class(TAbstractResourceReader) + private + fExtensions : string; + fDescription : string; + protected + function GetExtensions : string; override; + function GetDescription : string; override; + procedure Load(aResources : TResources; aStream : TStream); override; + function CheckMagic(aStream : TStream) : boolean; override; + procedure ReadRCFile(aResources : TResources; aLocation: String; aStream : TStream); + public + constructor Create; override; + destructor Destroy; override; + end; + +implementation + +uses + StreamIO, resdatastream, resfactory, lexlib, rcparser; + +{ TRCResourceReader } + +function TRCResourceReader.GetExtensions: string; +begin + Result:=fExtensions; +end; + +function TRCResourceReader.GetDescription: string; +begin + Result:=fDescription; +end; + +procedure TRCResourceReader.Load(aResources: TResources; aStream: TStream); +var + fd: String; +begin + if aStream is TFileStream then + fd:= ExtractFilePath(TFileStream(aStream).FileName) + else + fd:= IncludeTrailingPathDelimiter(GetCurrentDir); + try + ReadRCFile(aResources, fd, aStream); + except + on e : EReadError do + raise EResourceReaderUnexpectedEndOfStreamException.Create(''); + end; +end; + +function TRCResourceReader.CheckMagic(aStream: TStream): boolean; +begin + { TODO : Check for Text-Only file } + Result:= True; +end; + +procedure TRCResourceReader.ReadRCFile(aResources: TResources; aLocation: String; aStream: TStream); +begin + AssignStream(lexlib.yyinput, aStream); + Reset(lexlib.yyinput); + try + rcparser.yyfilename:= '#MAIN.RC'; + rcparser.PragmaCodePage('DEFAULT'); + SetTextCodePage(lexlib.yyinput, rcparser.opt_code_page); + rcparser.yinclude.init(); + rcparser.yinclude.WorkDir:= aLocation; + rcparser.ypreproc.init(); + rcparser.ypreproc.Defines.Add('RC_INVOKED'); + rcparser.aktresources:= aResources; + if rcparser.yyparse <> 0 then + raise EReadError.Create('Parse Error'); + rcparser.ypreproc.done(); + rcparser.yinclude.done(); + finally + end; +end; + +constructor TRCResourceReader.Create; +begin + fExtensions:='.rc'; + fDescription:='RC script resource reader'; +end; + +destructor TRCResourceReader.Destroy; +begin + +end; + +initialization + TResources.RegisterReader('.fpcres',TRCResourceReader); + TResources.RegisterReader('.frs',TRCResourceReader); + +end. diff --git a/packages/fcl-res/src/yyinclude.pp b/packages/fcl-res/src/yyinclude.pp new file mode 100644 index 0000000000..a27d4216f2 --- /dev/null +++ b/packages/fcl-res/src/yyinclude.pp @@ -0,0 +1,119 @@ +{%MainUnit rcparser.pas} + +{$IFDEF INC_HEADER} + +type + tyinclude = record + const + yi_maxlevels = 5; + var + stack: array[0..yi_maxlevels] of record + yyinput : Text; (* input and output file *) + yyline : String; (* current input line *) + yylineno, yycolno : Integer; (* current input position *) + fn : AnsiString; + prev_wrap : yywrap_t; + end; + level: integer; + WorkDir: string; + SearchPaths: TStringList; + public + procedure init(); + procedure done(); + class function wrapone(): Boolean; static; + function push(const incfile: ansistring): Boolean; + function pop(): Boolean; + function expand(fn: AnsiString): AnsiString; + end; + +var + yinclude: tyinclude; + +{$ELSE} + +class function tyinclude.wrapone(): Boolean; +begin + Result:= yinclude.pop; +end; + +function tyinclude.push(const incfile: ansistring): Boolean; +begin + stack[level].yyinput:= yyinput; + stack[level].yyline:= yyline; + stack[level].yylineno:= yylineno; + stack[level].yycolno:= yycolno; + stack[level].prev_wrap:= yywrap; + stack[level].fn:= yyfilename; + inc(level); + yywrap:= @tyinclude.wrapone; + AssignFile(yyinput, incfile); + Reset(yyinput); + yyfilename:= incfile; + yyline:= ''; + yylineno:= 0; + yycolno:= 0; + {$if declared(ypreproc)} + ypreproc.newfile(yyfilename); + {$endif} + Result:= true; +end; + +function tyinclude.pop(): Boolean; +begin + Close(yyinput); + Result:= level = 0; + if not Result then begin + Dec(level); + yyinput:= stack[level].yyinput; + yyline:= stack[level].yyline; + yylineno:= stack[level].yylineno; + yycolno:= stack[level].yycolno; + yywrap:= stack[level].prev_wrap; + yyfilename:= stack[level].fn; + {$if declared(ypreproc)} + ypreproc.newfile(yyfilename); + {$endif} + end; +end; + +function tyinclude.expand(fn: AnsiString): AnsiString; +var + i: integer; + f: string; +begin + result:= ''; + if Length(fn) > 3 then begin + if (fn[1] = '<') and (fn[length(fn)] = '>') then begin + fn:= copy(fn, 2, Length(fn)-2); + for i:= 0 to SearchPaths.Count - 1 do begin + f:= ConcatPaths([SearchPaths[i], fn]); + if FileExists(f) then + Exit(f); + end; + yyerror('Invalid file not found on search paths: "'+fn+'"'); + end + else if (fn[1] = '"') and (fn[length(fn)] = '"') then begin + fn:= copy(fn, 2, Length(fn)-2); + f:= ConcatPaths([WorkDir, fn]); + if FileExists(f) then + Exit(f); + yyerror('Invalid file not found: "'+fn+'"'); + end; + end; + yyerror('Invalid include directive: "'+fn+'"'); +end; + +procedure tyinclude.init(); +begin + level:= 0; + WorkDir:= GetCurrentDir; + SearchPaths:= TStringList.Create; +end; + +procedure tyinclude.done(); +begin + FreeAndNil(SearchPaths); +end; + +{$ENDIF} + diff --git a/packages/fcl-res/src/yypreproc.pp b/packages/fcl-res/src/yypreproc.pp new file mode 100644 index 0000000000..6d63115a57 --- /dev/null +++ b/packages/fcl-res/src/yypreproc.pp @@ -0,0 +1,150 @@ +{%MainUnit rcparser.pas} + +{$IFDEF INC_HEADER} + +type + typreproc = record + const + yp_maxlevels = 16; + var + Defines: TStringList; + skip : array[0..yp_maxlevels-1] of boolean; + cheadermode: boolean; + level : longint; + public + procedure init(); + procedure done(); + function isdefine(ident: string): boolean; + function getdefine(ident: string): string; + function useline(line: string): boolean; + procedure newfile(fn: string); + end; + +var + ypreproc: typreproc; + +{$ELSE} + +procedure typreproc.init(); +begin + Defines:= TStringList.Create; + Defines.CaseSensitive:= False; + level:= 0; + cheadermode:= false; + fillchar(skip,sizeof(skip),0); +end; + +procedure typreproc.done(); +begin + FreeAndNil(Defines); +end; + +function Copy2SpaceDelTrim(var s: string): string; +const + whitespace = [#9, ' ']; +var + p: integer; +begin + p:= PosSet(whitespace, s); + if p <= 0 then begin + result:= s; + s:= ''; + end else begin + result:= Copy(S, 1, p-1); + while (p < Length(s)) and (s[p] in whitespace) do + inc(p); + Delete(s, 1, p-1); + end; +end; + +function Substring(s: string; First, Last: integer): string; +begin + Result:= Copy(s, First, Last-First+1); +end; + +function typreproc.isdefine(ident: string): boolean; +begin + Result:= Defines.IndexOfName(ident) >= 0; +end; + +function typreproc.getdefine(ident: string): string; +begin + Result:= Defines.Values[ident]; +end; + +function typreproc.useline(line: string): boolean; +var + w, word, arg1: string; +begin + Result:= true; + w:= trim(line); + if (yystate <= 1) and + (Length(w) > 2) and (w[1] = '#') then begin + Delete(w, 1, 1); + word:= Copy2SpaceDelTrim(w); + case word of + 'ifdef': begin + inc(Level); + if Level >= yp_maxlevels then begin + yyerror('Too many ifdef levels'); + exit; + end; + skip[level]:= (skip[level-1] or (not isdefine(w))); + end; + 'ifndef': begin + inc(Level); + if Level >= yp_maxlevels then begin + yyerror('Too many ifdef levels'); + exit; + end; + skip[level]:= (skip[level-1] or (isdefine(w))); + end; + 'else': begin + skip[level]:= skip[level-1] or (not skip[level]); + end; + 'endif': begin + skip[level]:= false; + if Level = 0 then begin + yyerror('Too many endif found'); + exit; + end; + dec(level); + end; + else + if not skip[level] then + case word of + 'pragma': begin + if StartsStr('code_page(', w) then begin + arg1:= Substring(w, Length('code_page(') + 1, Pos(')', w) - 1); + PragmaCodePage(arg1); + end; + end; + 'define': begin + arg1:= Copy2SpaceDelTrim(w); + Defines.Values[arg1]:= w; + end; + 'undef': begin + Defines.Delete(Defines.IndexOfName(arg1)); + end; + 'include': begin + arg1:= yinclude.expand(w); + yinclude.push(arg1); + end; + end; + end; + Result:= false; + end else begin + Result:= (not cheadermode) and (not skip[level]); + end; +end; + +procedure typreproc.newfile(fn: string); +var + ex: String; +begin + ex:= UpperCase(ExtractFileExt(yyfilename)); + cheadermode:= (ex = '.C') or (ex = '.H'); +end; + + +{$ENDIF} diff --git a/utils/fpcres/fpcres.pas b/utils/fpcres/fpcres.pas index 7788c47233..5738b8c7ee 100644 --- a/utils/fpcres/fpcres.pas +++ b/utils/fpcres/fpcres.pas @@ -23,12 +23,11 @@ uses closablefilestream, resource, //readers resreader, coffreader, winpeimagereader, elfreader, machoreader, - externalreader, dfmreader, tlbreader, + externalreader, dfmreader, tlbreader, rcreader, //writers reswriter, coffwriter, xcoffwriter, elfwriter, machowriter, externalwriter, //misc - elfconsts, cofftypes, machotypes, externaltypes - ; + elfconsts, cofftypes, machotypes, externaltypes; const halt_no_err = 0;