X-Git-Url: http://git.madism.org/?p=apps%2Fmadmutt.git;a=blobdiff_plain;f=tools%2Fcpkg2c.mll;h=82be124f77b2d8fcd87475c23cb016b95cb48120;hp=0eccf4778139f4b06efbf4278095f41a48f2e7a3;hb=e1f82ec5b248a12c5bfef139f1f27bf4292ee3a0;hpb=a19e0acbcbc4a8d4238cda051ca702653450c1cb

diff --git a/tools/cpkg2c.mll b/tools/cpkg2c.mll
index 0eccf47..82be124 100644
--- a/tools/cpkg2c.mll
+++ b/tools/cpkg2c.mll
@@ -22,11 +22,8 @@
   module H = Hashtbl
   module B = Buffer
 
-  type 'a anchor = ('a * string * int)
-
+  type 'a anchor   = ('a * string * int)
   let t1 (a, _, _) = a
-  let t2 (_, a, _) = a
-  let t3 (_, _, a) = a
 
   let die lpos fpos s =
     output_string stderr (sprintf "%s:%d: %s\n" fpos lpos s);
@@ -34,6 +31,14 @@
 
   let put_line = printf "#line %d \"%s\"\n"
 
+  let isspace = function |' '|'\t' -> true | _ -> false
+
+  let strip s =
+    let l = ref 0 and r = ref (String.length s) in
+    while (isspace s.[!l]     && !l < !r) do incr l done;
+    while (isspace s.[!r - 1] && !l < !r) do decr r done;
+    String.sub s !l (!r - !l)
+
 (* @types related {{{ *)
 
   type typedef =
@@ -46,9 +51,9 @@
     }
   let typedef0 =
     { lpos  = 0; fpos = "";
-      ctype = ("", "", 0);
-      check = ("", "", 0);
-      push  = ("", "", 0);
+      ctype = "", "", 0;
+      check = "", "", 0;
+      push  = "", "", 0;
       ctor  = None;
       dtor = None
     }
@@ -67,7 +72,14 @@
   type typinst = bool * typedef
 
   type members =
-    { typ: typinst; mname: string; init: string }
+    { typ: typinst; mname: string;
+      init: string anchor; onchange: string anchor option; }
+  let member0 =
+    { typ   = false, typedef0;
+      mname = "";
+      init = "", "", 0;
+      onchange = None;
+    }
 
   type methods =
     { rettype: typinst list; args: (typinst * string) list;
@@ -94,9 +106,9 @@
       | [t]          -> (false, type_find lpos fpos t)
       | _ -> assert false
     in
-    match s with
+    match strip s with
     | "void" -> []
-    | s      -> List.map aux (Str.split (Str.regexp "[ \t]+,[ \t]+") s)
+    | s      -> List.map aux (Str.split (Str.regexp "[ \t]*,[ \t]*") s)
 
   let parse_args lpos fpos s =
     let aux t =
@@ -105,9 +117,9 @@
       | [t; n]          -> ((false, type_find lpos fpos t), n)
       | _ -> assert false
     in
-    match s with
+    match strip s with
     | "void" -> []
-    | s      -> List.map aux (Str.split (Str.regexp "[ \t]+,[ \t]+") s)
+    | s      -> List.map aux (Str.split (Str.regexp "[ \t]*,[ \t]*") s)
 
 (* }}} *)
 (* parsing helpers {{{ *)
@@ -160,7 +172,6 @@ let sp     = [' ''\t']
 let typdecl = sp* ("const" sp+)? ident sp*
 
 (* }}} *)
-
 (* entry point {{{ *)
 
 rule cLine lpos fpos buf = parse
@@ -274,13 +285,23 @@ and ext_pkg pkg = parse
 | '\n'              { ext_pkg pkg (nextl lexbuf) }
 | "/*"              { let _ = cComment (B.create 1024) lexbuf in
                       ext_pkg pkg lexbuf }
+| ("const" sp+ as const)? (ident as typ) sp+
+  (ident as member) sp* '=' sp* '{'
+                    {
+                      let m = {member0 with mname = member;
+                               typ = const != None, type_find (lnum lexbuf)
+                               pkg.file typ; } in
+                      let m = ext_member m pkg.file lexbuf in
+                      ext_pkg {pkg with members = (m, pkg.file, lnum lexbuf)::pkg.members} lexbuf
+                    }
 | ("const" sp+ as const)? (ident as typ) sp+
   (ident as member) sp* '=' sp* ([^';''\n']* as init)';'
                     {
                       let m = { typ   = const != None,
                                         type_find (lnum lexbuf) pkg.file typ;
                                 mname = member;
-                                init  = init; }, pkg.file, lnum lexbuf in
+                                init  = init, pkg.file, lnum lexbuf;
+                                onchange = None; }, pkg.file, lnum lexbuf in
                       ext_pkg {pkg with members = m::pkg.members} lexbuf
                     }
 | '(' ((typdecl ',')* typdecl as ret) ')' sp*
@@ -329,9 +350,35 @@ and ext_bodycode buf = parse
 | '}'     as c      { buf @< c }
 | _       as c      { ext_bodycode (buf @< c) lexbuf }
 
+(* }}} *)
+(* parse extended member {{{ *)
+
+and ext_member m f = parse
+| sp+
+| "//" to_eol       { ext_member m f lexbuf }
+| '\n'              { ext_member m f (nextl lexbuf) }
+| "/*"              { let _ = cComment (B.create 1024) lexbuf in
+                      ext_member m f lexbuf }
+| '.' (ident as member) sp* '=' sp* ([^';''\n']+ as s) ';'
+                    {
+                      ext_member (
+                        let do_anch s = s, f, lnum lexbuf in
+                        match member with
+                        | "init"     -> {m with init = do_anch s}
+                        | "onchange" -> {m with onchange = Some(do_anch s)}
+                        | _       ->
+                            die (lnum lexbuf) f
+                              (sprintf "Unknown directive `%s'" member)
+                      ) f lexbuf
+                    }
+| '}' sp* ';'       { m }
+| ""                { die (lnum lexbuf) f "Syntax error" }
+
 (* }}} *)
 
 {
+(* templating functions {{{ *)
+
   let upper = String.uppercase
   let tplize tpl v =
     Str.global_replace (Str.regexp_string "$L") "L" (
@@ -417,7 +464,7 @@ and ext_bodycode buf = parse
     ) 0 fn.args);
     printf "\n#define RAISE(s)  luaL_error(L, (s))\n";
     if fn.rettype = [] then (
-      printf "#define RETURN return luaM_ret_%s_%s(L)\n" pkg.name fn.fname
+      printf "#define RETURN()  return luaM_ret_%s_%s(L)\n" pkg.name fn.fname
     ) else (
       printf "#define RETURN(luaM_x1";
       for i = 2 to retlen do printf ", luaM_x%d" i done;
@@ -438,25 +485,32 @@ and ext_bodycode buf = parse
           else
             printf "struct luaM_%s_t %s = {\n" pkg.name pkg.name
           );
-          List.iter (function (m, f, l) ->
+          List.iter (function (m, _, _) ->
+              let (init, f, l) = m.init in
               put_line l f;
-              printf "    %s,\n" (if fst m.typ then m.init else "0")
+              printf "    %s,\n" (if fst m.typ then init else "0")
             ) pkg.members;
           printf "};\n";
 
           (* dump struct init func *)
           printf "\nstatic void %s_init(void)\n{\n" pkg.name;
-          List.iter (function (m, f, l) ->
+          List.iter (function (m, _, _) ->
             if not (fst m.typ) then
-              printf "#line %d \"%s\"\n    %s.%s = %s;\n"
-              l f pkg.name m.mname m.init) pkg.members;
+              let init, f, l = m.init in
+              let field = sprintf "%s.%s" pkg.name m.mname in
+              put_line l f;
+              printf "    %s = %s;\n" field init;
+              match m.onchange with
+              | None           -> ()
+              | Some(on, f, l) ->
+                  put_line l f; printf "    %s;\n" (tplize on field)
+            ) pkg.members;
           printf "};\n\n";
 
           (* dump __index *)
           printf "static int luaM_%s_index(lua_State *L)\n{\n" pkg.name;
           printf "    const char *idx = luaL_checkstring(L, 2);\n\n";
           printf "    switch (mlua_which_token(idx, -1)) {\n";
-          printf "      default:\n";
           List.iter (function (m, _, _) ->
             printf "      case LTK_%s:\n" (upper m.mname);
             let push, f, l = (snd m.typ).push in
@@ -464,7 +518,8 @@ and ext_bodycode buf = parse
             printf "        %s;\n" (tplize push (sprintf "%s.%s" pkg.name m.mname));
             printf "        return 1;\n"
           ) pkg.members;
-          printf "        lua_rawget(L, lua_upvalueindex(2));\n";
+          printf "      default:\n";
+          printf "        lua_rawget(L, lua_upvalueindex(1));\n";
           printf "        return 1;\n";
           printf "    }\n}\n\n";
 
@@ -473,6 +528,7 @@ and ext_bodycode buf = parse
           printf "    const char *idx = luaL_checkstring(L, 2);\n\n";
           printf "    switch (mlua_which_token(idx, -1)) {\n";
           List.iter (function (m, _, _) ->
+            let field = sprintf "%s.%s" pkg.name m.mname in
             match m.typ with
             | true, _ -> ()
             | false, t ->
@@ -481,24 +537,31 @@ and ext_bodycode buf = parse
               | None -> ()
               | Some (dtor, f, l) ->
                   put_line l f;
-                  printf "        %s;\n" (tplize dtor (sprintf "&%s.%s" pkg.name m.mname))
+                  printf "        %s;\n" (tplize dtor ("&" ^ field))
               );
               (match t.ctor with
               | None ->
                   let (c, f, l) = t.check in
                   put_line l f;
-                  printf "        %s.%s = %s;\n" pkg.name m.mname (tplize c "3")
+                  printf "        %s = %s;\n" field (tplize c "3")
               | Some (ctor, f, l) ->
                   let v =
                     let c, f, l = t.check in
                     tplize (sprintf "\n#line %d \"%s\"\n            %s" l f c) "3"
                   in
                   put_line l f;
-                  printf "        %s.%s = %s;\n" pkg.name m.mname (tplize ctor v)
+                  printf "        %s = %s;\n" field (tplize ctor v)
+              );
+              (match m.onchange with
+              | None           -> ()
+              | Some(on, f, l) ->
+                  put_line l f;
+                  printf "        %s;\n" (tplize on field)
               );
               printf "        return 1;\n"
           ) pkg.members;
           printf "      default:\n";
+          printf "        lua_rawset(L, lua_upvalueindex(1));\n";
           printf "        return 1;\n";
           printf "    }\n}\n";
 
@@ -514,7 +577,7 @@ and ext_bodycode buf = parse
 
 int luaopen_%s(lua_State *L)
 {
-    int mt, methods;
+    int mt, members, methods;
 
     %s_init();
 
@@ -522,18 +585,20 @@ int luaopen_%s(lua_State *L)
     luaL_openlib(L, \"%s\", luaM_%s_methods, 0);
     methods = lua_gettop(L);
 
+    lua_newtable(L);                            /* for new members   */
+    members = lua_gettop(L);
+
     /* create metatable for %s, add it to the registry */
     luaL_newmetatable(L, \"%s\");
     mt = lua_gettop(L);
 
-    lua_pushliteral(L, \"%s\");
-    lua_pushvalue(L, mt);                       /* upvalue 1         */
-    lua_pushvalue(L, methods);                  /* upvalue 2         */
-    lua_pushcclosure(L, &luaM_%s_index, 2);
+    lua_pushliteral(L, \"__index\");
+    lua_pushvalue(L, members);                  /* upvalue  1        */
+    lua_pushcclosure(L, &luaM_%s_index, 1);
     lua_rawset(L, mt);                          /* set mt.__index    */
 
     lua_pushliteral(L, \"__newindex\");
-    lua_newtable(L);                            /* for new members   */
+    lua_pushvalue(L, members);                  /* upvalue  1        */
     lua_pushcclosure(L, &luaM_%s_newindex, 1);
     lua_rawset(L, mt);                          /* set mt.__newindex */
 
@@ -543,13 +608,15 @@ int luaopen_%s(lua_State *L)
 
     lua_setmetatable(L, methods);
 
-    lua_pop(L, 1);                              /* drop mt           */
-    return 1;                                   /* return methods    */
+    lua_pop(L, 3);
+    return 1;
 }
 
 ")
     in List.iter do_c_aux
 
+(* }}} *)
+
   let usage () =
     output_string stderr "usage: cpkg2c (-h | -c) file.cpkg\n";
     exit 1