gtk-server.l (1141B)
1 # line: fname, callback signal type, retval, nargs, arg1, arg2... 2 3 (de fixType (Type) 4 (case Type 5 (NONE 'void) 6 (LONG 'long) 7 (BOOL 'bool) 8 (STRING 'cstr) 9 (FLOAT 'float) 10 (DOUBLE 'double) 11 (NULL 'null) 12 (WIDGET 'GtkWidget*) 13 (T Type))) 14 15 (out "gtk.ffi" 16 (prinl "# -*- picolisp -*-") 17 (prinl) 18 (prinl "(load \"@src/mod/ffi.l\")") 19 (prinl) 20 (prinl "(module gtk)") 21 (prinl) 22 (prinl "(include \"gtk/gtk.h\")") 23 (prinl) 24 (prinl "(put 'cwrap 'GtkWidget* (get 'cwrap 'void*))") 25 (prinl) 26 (prinl "(put 'cbody 'GtkWidget* (get 'cbody 'void*))") 27 (prinl) 28 (in "gtk-server.cfg" 29 (until (eof) 30 (let Line (line) 31 (unless (= "#" (car Line)) 32 (when (match 33 '("FUNCTION_NAME" "=" @Fn @Cb @Rv @Na . @Args) 34 (mapcar pack (split (filter '((X) (<> X ",")) Line) " "))) 35 (println (append (list 'cfun 36 (fixType (intern (car @Rv))) 37 (intern (car @Fn))) 38 (mapcar fixType @Args)))))))))