%%%----------------------------------------------------------------------
%%% File    : vtcl.erl
%%% Author  : Claes Wistrom <klacke@jb>
%%% Purpose : Take output from guibuilder vtcl and make an etk/erlang program
%%%           Works reasonable well for at least some common output from vtcl
%%% Created :  6 Mar 1999 by Claes Wikstrom <klacke@jb>
%%%----------------------------------------------------------------------

%% This program is only known to work with vtcl 1.2.0
%% The vtcl gui builder can be found at the www.scriptics.com site
%% or at http://www.neuron.com/stewart/vtcl/
%% Usage: 1 Make a gui with vtcl 
%%          (Don't add any commands to buttons and such)
%%        2 Save to a file, say "funky.tcl"
%%        3 Run vtcl:file("funky.tcl") in Erlang
%%        4 Result is now in funky.erl

%% Since vtcl utilizes some tk8.0 stuff such as 
%% font specs like -font {Times -12} and erlang etk
%% is based on tk4.2 not everything translates that well.
%% But nevertheless, .....


-module(vtcl).
-author('klacke@bluetail.com').
-import(lists, [map/2, foreach/2, member/2, 
		reverse/1, filter/2, flatten/1, foldr/3]).
-export([file/1]).

%%-compile(export_all).


file(F) ->
    T2 = lines(F),
    case file:open(filename:rootname(F) ++ ".erl", [write]) of
	{ok, Fd} -> 
	    put(out, Fd),
	    Mod=filename:basename(filename:rootname(F)),
	    gen_header(Fd, Mod),
	    gen(T2),
	    erase(out);
	Other2 ->
	    exit(Other2)
    end.



tokens(F) ->
    case file:read_file(F) of
	{ok, B} -> 
	    toks(binary_to_list(B), bol);
	Other->
	    exit(Other)
    end.

lines(F) ->
    linify(tokens(F)).


f(Fmt) -> f(Fmt, []).
f(Fmt, Args) -> ok=io:format(get(out), Fmt, Args).

nl() ->    io:format(get(out),"~n", []).
    


gen_header(Fd, Mod) ->
    f("-module(~s).~n~n", [Mod]),
    f("% Code generated by the vtcl.erl program ~n"),
    f("% Please feel free to edit this code, beware that the file "
      "~n%% will be overwritten if the vtcl.erl program is run again~n~n"),
    f("-export([window/0]).~n~n").


gen(Toks) ->
    f("window() -> ~n"),
    T2 = eat_proc_line(Toks),
    [_, Set, [rbrace], _, _, [rbrace] | Tail] = T2,
    [{string, "set"}, {string, "base"}, {string, Base}] = Set,
    f("Base  = ~p,~nSelf  = self(), ~n", [Base]),
    Svar = subst_var(Tail, [{"base", Base}]),
    foreach(fun(Line) ->
		    gline(Line) 
	    end, Svar).

eat_proc_line([Line|Lines]) ->
    case Line  of
	[{string, "proc"}, 
	 {string, [$v,$T,$c,$l,$W,$i,$n,$d,$o,$w,$., X |_]} |_] ->
	    drop_trail(Lines);
	_ ->
	    eat_proc_line(Lines)
    end.

drop_trail([[{string, Window}, {string, "show"}|_] | _]) ->
    [];
drop_trail([Line|Lines]) ->
    [Line|drop_trail(Lines)];
drop_trail([]) ->
    [].

gline([{comment, C}]) ->
    f("%% ~p~n", [C]);
gline([{string, Cmd} | Tail]) ->
    case command_type(Cmd) of
	{create_cmd, "toplevel"} ->
	    [{string, W}|T2] = Tail,
	    f("tk:toplevel(~p,  ", [W]),
	    g_options(T2);
	{create_cmd, "wm"} ->
	    f("tk:wm("),
	    g_options(Tail);
	{create_cmd, "bind"} ->
	    io:format("Sorry, can't do bindings ~n", []),
	    exit(bind);
	{create_cmd , Cmd} ->
	    [{string, W}|T2] = Tail,
	    f("tk:~s(~p, ", [Cmd, W]), 
	    nl(),
	    case member(Cmd, ["button"]) of
		true ->  %% Add -command
		    f("[{command, fun() -> Self ! {~p, ~p} end}", 
		      [list_to_atom(Cmd),
		       get_text_opt(Cmd, T2)]),
		    handle_options_tail(del_command_opt(T2));
		false ->
		    g_options(T2)
	    end;
	widget_cmd ->
	    f("tk:cmd(~p, ", [Cmd]),
	    g_options(Tail)
    end;
gline([rbrace]) ->
    % we're done
    f("tk:wlink(Base),~n"),
    f("Base.~n");
gline(_) ->
    ignore.

cmds() -> ["wm", "toplevel", "frame", "menubutton", "label", "bind",
	  "scrollbar", "button", "canvas", "place", "pack",
	  "grid", "message", "entry", "menu"].
    
command_type(Cmd) ->
    case member(Cmd, cmds()) of
	true ->
	    {create_cmd, Cmd};
	false ->
	    widget_cmd
    end.

get_cmd_toks([lbrace | T]) ->
    get_cmd_toks(T, 1, []).

get_cmd_toks([rbrace|T], 1, Ack) ->
    {reverse(Ack), T};
get_cmd_toks([rbrace|T], Level, Ack) ->
    {reverse(Ack), Level-1, T};
get_cmd_toks([lbrace|T], Level, Ack) ->
    {reverse(Ack), Level+1, T};
get_cmd_toks([H|T], Level, Ack) ->
    get_cmd_toks(T, Level, [H|Ack]).


gen_cmd_fun(1, [{string, W} | Cmds]) ->
    f("fun(Args) -> tk:cmd(~p, [", [W]),
    gen_cmd_fun_body(W, Cmds);
gen_cmd_fun(2, [{string, W} | Cmds]) ->
    f("fun(From, To) -> tk:cmd(~p, [", [W]),
    gen_cmd_fun_body(W, Cmds).

gen_cmd_fun_body(W, Cmds) ->
    {_,Last} = foreach_butlast(fun({string, Str}) ->
				   f("~p, ", [Str])
			   end, Cmds),
     f("~p | Args]) end", [Last]).

get_text_opt(Default, [{dash, "text"}, {string, Str}|_]) ->
    Str;
get_text_opt(Default, [H|T]) ->
    get_text_opt(Default, T);
get_text_opt(Default, []) ->
    Default.

del_command_opt([{dash, "command"}, {string, Str} |T]) ->
    T;
del_command_opt([{dash, "command"}, lbrace|T]) ->
    del_upto(rbrace, T);
del_command_opt([H|T]) ->
    [H | del_command_opt(T)];
del_command_opt([]) ->
    [].

del_upto(H, [H|T]) ->
    T;
del_upto(H1, [H2|T]) ->
    del_upto(H1, T);
del_upto(H, []) ->
    [].

g_options(X) ->
    f(" [ "),
    g_options2(X).

g_options2([{dash, "command"} | Tail]) ->
    {Cmds, T2} = get_cmd_toks(Tail),
    case filter(fun({string, _}) -> false;
		   ({dash, _}) -> false;
		   (_) -> true
		end, Cmds) of
	[] ->  %% just simple syting toks
	    f("{command, " ),   
	    gen_cmd_fun(1, Cmds),   
	    f("}"),
	    handle_options_tail(T2);
	_ ->
	    Str = io_lib:format("~s", [pp(Cmds)]),
	    f("{command, fun() -> io:format(' Can not do ~s ~n ', []) end}", [Str]),
	    handle_options_tail(T2)
    end;

g_options2([{dash, "xscrollcommand"} | Tail]) ->
    {[{string, W} | Cmds], T2} = get_cmd_toks(Tail),
    f("{xscrollcommand, " ),   
    f("fun(From, To) -> tk:cmd(~p, [set, From, To]) end}", [W]), 
    handle_options_tail(T2);

g_options2([{dash, "yscrollcommand"} | Tail]) ->
    {[{string, W} | Cmds], T2} = get_cmd_toks(Tail),
    f("{yscrollcommand, " ),   
    f("fun(From, To) -> tk:cmd(~p, [set, From, To]) end}", [W]), 
    handle_options_tail(T2);

% opt values that begin with - !!
g_options2([{dash, Str}, {dash,Str2} |Tail]) ->  
    g_options2([{dash, Str}, {string,[$-|Str2]} |Tail]);

g_options2([{dash, "font"}, lbrace | Tail]) ->
    {Cmd, T2} =  get_cmd_toks([lbrace |Tail]),
    io:format("Ignoring tk8.0 font style spec  ~s ~n", [pp([lbrace|Tail])]),
    case T2 of 
	[] ->
	  f("]), ~n");
	_ ->
	   g_options2(T2)
    end;
			   

g_options2([{dash, Str}, lbrace, rbrace | Tail]) ->
    g_options2([{dash, Str}, {string, ""} | Tail]);


%% Optvalues within braces
g_options2([{dash, Str}, lbrace | Tail]) ->
    {Cmd, T2} =  get_cmd_toks([lbrace |Tail]),
    f("{~s, [", [Str]),
    {_, Lst} = foreach_butlast(fun({string, String}) ->
				       f("~p, ", [[$ |String]]);
				  ({dash, String}) ->
				       f("~p, ", [[$ , $-|String]]);
				  (Other) ->
				        f("~p, ", [pp([Other])])
			       end, Cmd),
    f("~p ]} ", [[$ |Lst]]),
    handle_options_tail(T2);


g_options2([{dash, Str} , {string, Oval} | Tail])  ->
    f("{~p, ~p}", [maybe_atom(Str), oval(Oval)]),
    handle_options_tail(Tail);

g_options2([{dash, Str} , {qstring, Oval} | Tail])  ->
    f("{~p, ~p}", [maybe_atom(Str), Oval]), 
    handle_options_tail(Tail);

g_options2([{string, Str}| Tail]) ->
    f("~p", [oval(Str)]),
    handle_options_tail(Tail);
g_options2([{qstring, Str}| Tail]) ->
    f("~p", [oval(Str)]),
    handle_options_tail(Tail);
g_options2([]) ->
    f("]), ~n").

handle_options_tail([]) ->
    f("]), ~n");
handle_options_tail(Tail) ->
    f(",", []),
    nl(),
    g_options2(Tail).

oval(Str) ->
    case catch list_to_integer(Str) of
	{'EXIT', _} ->
	    maybe_atom(Str);
	I ->
	    I
    end.

maybe_atom([H|T]) when $a =< H, H =< $z ->
    list_to_atom([H|T]);
maybe_atom(X) ->
     X.

subst_var(TokList, Bs) ->
    map(fun(Toks) ->
		map(fun(Tok) -> substit_var(Tok, Bs) end, Toks)
	end, TokList).

substit_var({dollar_string, Str}, Bs) ->
    {string, svar(Str, Bs)};
substit_var(X, Bs) ->
    X.

%% XXX FIXME ??
svar([$$, $b, $a, $s, $e|Tail], [{"base", Base}]) ->
    Base ++ Tail;
svar([H|T], Bs) ->
    [H| svar(T,Bs)];
svar([], _) ->
    [].

linify(Toks) ->
    reverse(linify(Toks, [], [])).

linify([newline|T], Line, All) ->
    linify(T, [], [reverse(Line) |All]);
linify([], Line, All) -> [Line |All];

linify([H|T], Line, All) ->
    linify(T, [H|Line], All).

%% Keep track of where since $# is different whether it's the 
%% first char in a line or not
toks(Chars, Where) ->
    case next_tok(Chars, Where) of
	{Tok, Tail, Where2} -> [Tok | toks(Tail, Where2)];
	done -> []
    end.

next_tok([], _) ->
    done;
next_tok([$\\,$\n |T], Where) ->
    next_tok(T, Where);
next_tok([H|T], Where) ->
    case ctype(H, Where) of
	dash -> {String, Tail} = get_str_chars(T),
		{{dash, String}, Tail, inline};
	dollar -> {String, Tail} = get_str_chars(T),
		  {{dollar_string, [H|String]}, Tail, inline};
	    
	comment ->
	    {Comment, Tail} = get_while(T, fun(Ch) ->
						   Ch /= $\n
					   end),
	    {{comment, Comment}, Tail, inline};
	char ->
	    {String, Tail} = get_str_chars(T),
	    {{string, [H|String]}, Tail, inline};
	newline ->
	    {newline, T, bol};
	{paren, Type} ->
	    {Type, T, inline};
	doublequote ->
	    {Str, Tail} = get_while(T, fun(Ch) ->
					       Ch /= $"
				       end),
	    {{qstring, Str}, tl(Tail), inline};
	space ->
	    next_tok(T, Where);
	special ->
	    Spc = specials(),
	    {Special, Tail} = get_while(T, fun(C) ->
						   member(C, Spc)
					   end),
	    {{special, [H|Special]}, Tail, inline}
    end.

ctype($\n, W) -> newline;
ctype($-, W) -> dash;
ctype($$, W) -> dollar;
ctype(${, W) -> {paren, lbrace};
ctype($}, W) -> {paren, rbrace};
ctype($#, bol) -> comment;
ctype($", W) -> doublequote;
ctype(X, W) -> case is_space(X) of
		   true ->
		       space;
		   false ->
		       case member(X, specials()) of
			   true ->
			       special;
			   false ->
			       char
		       end
	       end.

specials() ->
    "!&;|=".

is_space($ ) -> true;
is_space($\t) -> true;
is_space(_) -> false.
	 

get_while(Chars, Fun) ->
    get_while(Chars, Fun, []).
get_while([H|T], Fun, Ack) ->
    case Fun(H) of
	true ->
	    get_while(T, Fun, [H|Ack]);
	false ->
	    {reverse(Ack), [H|T]}
    end;
get_while([], Fun, Ack) ->
    {reverse(Ack), []}.

get_str_chars(Chars) ->
    F = fun(C) ->
		if 
		    $0 =< C, C =< $9 ->
			true;
		    $A =< C, C =< $z ->
			true;
		    true ->
			member(C, "[],./*+-#<>")
		end
	end,
    get_while(Chars, F).

foreach_butlast(Fun, [Last]) ->
    Last;
foreach_butlast(Fun, [H|T]) ->
    Fun(H),
    foreach_butlast(Fun, T).

pp(Commands) ->
    flatten(foldr(
	      fun({string, Str}, Ack) ->
		      Str ++ [$ | Ack];
		 ({dash, Str}, Ack) ->
		      [$ , $- |Str] ++ Ack;
		 (lbrace, Ack) ->
		      "{ " ++ Ack;
		 (rbrace, Ack) ->
		      "} " ++ Ack;
		 ({qstring, Str}, Ack) ->
		      Str ++ [$ | Ack];
		 (newline, Ack) ->
		      [$\n | Ack];
		 ({special, Str}, Ack) ->
		      Str ++ [$ | Ack];
		 (X, Ack) ->
		      io_lib:format("~p~s", [X, Ack])
	      end, "", Commands)).