462
+ − 1 (defconst name-to-return-type
+ − 2 '(("INT" . "guint")
+ − 3 ("CALLBACK" . "GtkCallback")
+ − 4 ("OBJECT" . "GtkObject *")
+ − 5 ("POINTER" . "void *")
+ − 6 ("STRING" . "gchar *")
+ − 7 ("BOOL" . "gboolean")
+ − 8 ("DOUBLE" . "gdouble")
+ − 9 ("FLOAT" . "gfloat")
+ − 10 ("LIST" . "void *")
+ − 11 ("NONE" . nil)))
+ − 12
+ − 13 (defvar defined-marshallers nil)
+ − 14
+ − 15 (defun get-marshaller-name (rval args)
+ − 16 (concat "emacs_gtk_marshal_" rval "__"
+ − 17 (mapconcat 'identity (or args '("NONE")) "_")))
+ − 18
+ − 19 (defun define-marshaller (rval &rest args)
+ − 20 (let ((name nil)
+ − 21 (internal-rval (assoc rval name-to-return-type))
+ − 22 (ctr 0)
+ − 23 (func-proto (format "__%s_fn" rval)))
+ − 24 (if (not internal-rval)
+ − 25 (error "Do not know return type of `%s'" rval))
+ − 26 (setq name (get-marshaller-name rval args))
+ − 27
+ − 28 (if (member name defined-marshallers)
+ − 29 (error "Attempe to define the same marshaller more than once! %s" name))
+ − 30
+ − 31 (set-buffer (get-buffer-create "emacs-marshals.c"))
+ − 32 (goto-char (point-max))
+ − 33
+ − 34 (if (or (member "FLOAT" args) (member "DOUBLE" args))
+ − 35 ;; We need to special case anything with FLOAT in the argument
+ − 36 ;; list or the parameters get screwed up royally.
+ − 37 (progn
+ − 38 (setq func-proto (concat (format "__%s__" rval)
+ − 39 (mapconcat 'identity args "_")
+ − 40 "_fn"))
+ − 41 (insert "typedef "
+ − 42 (or (cdr internal-rval) "void")
+ − 43 " (*"
+ − 44 func-proto ")("
+ − 45 (mapconcat (lambda (x)
+ − 46 (cdr (assoc x name-to-return-type))) args ", ")
+ − 47 ");\n")))
+ − 48
+ − 49 (insert "\n"
+ − 50 "static void\n"
+ − 51 name " (ffi_actual_function func, GtkArg *args)\n"
+ − 52 "{\n"
+ − 53 (format " %s rfunc = (%s) func;\n" func-proto func-proto))
+ − 54
+ − 55 (if (string= "LIST" rval) (setq rval "POINTER"))
+ − 56
+ − 57 (if (cdr internal-rval)
+ − 58 ;; It has a return type to worry about
+ − 59 (insert " " (cdr internal-rval) " *return_val;\n\n"
+ − 60 (format " return_val = GTK_RETLOC_%s (args[%d]);\n" rval (length args))
+ − 61 " *return_val = ")
+ − 62 (insert " "))
+ − 63 (insert "(*rfunc) (")
+ − 64 (while args
+ − 65 (if (/= ctr 0)
+ − 66 (insert ", "))
+ − 67 (insert (format "GTK_VALUE_%s (args[%d])" (car args) ctr))
+ − 68 (setq args (cdr args)
+ − 69 ctr (1+ ctr)))
+ − 70 (insert ");\n")
+ − 71 (insert "}\n")))
+ − 72
+ − 73 (save-excursion
591
+ − 74 (find-file "../src/emacs-marshals.c")
462
+ − 75 (erase-buffer)
+ − 76 (setq defined-marshallers nil)
+ − 77
591
+ − 78 (insert "/* This file was automatically generated by ../lisp/gtk-marshal.el */\n"
+ − 79 "/* DO NOT EDIT BY HAND!!! */\n")
462
+ − 80 (insert "#define GTK_VALUE_ARRAY(x) GTK_VALUE_POINTER(x)\n\n")
+ − 81 (insert "#define GTK_VALUE_LIST(x) GTK_VALUE_POINTER(x)\n\n")
+ − 82
+ − 83 (let ((todo '(
+ − 84 ("BOOL" "OBJECT" "INT")
+ − 85 ("BOOL" "OBJECT" "OBJECT" "OBJECT")
+ − 86 ("BOOL" "OBJECT" "OBJECT")
+ − 87 ("BOOL" "OBJECT" "POINTER")
+ − 88 ("BOOL" "OBJECT" "STRING")
+ − 89 ("BOOL" "OBJECT")
+ − 90 ("BOOL" "POINTER" "BOOL")
+ − 91 ("BOOL" "POINTER")
+ − 92 ("BOOL")
+ − 93 ("FLOAT" "OBJECT" "FLOAT")
+ − 94 ("FLOAT" "OBJECT")
+ − 95 ("INT" "BOOL")
+ − 96 ("INT" "OBJECT" "ARRAY")
+ − 97 ("INT" "OBJECT" "INT" "ARRAY")
+ − 98 ("INT" "OBJECT" "INT" "INT")
+ − 99 ("INT" "OBJECT" "INT" "STRING")
+ − 100 ("INT" "OBJECT" "INT")
+ − 101 ("INT" "OBJECT" "OBJECT")
+ − 102 ("INT" "OBJECT" "POINTER" "INT" "INT")
+ − 103 ("INT" "OBJECT" "POINTER" "INT")
+ − 104 ("INT" "OBJECT" "POINTER")
+ − 105 ("INT" "OBJECT" "STRING")
+ − 106 ("INT" "OBJECT")
+ − 107 ("INT" "POINTER" "INT")
+ − 108 ("INT" "POINTER" "STRING" "INT")
+ − 109 ("INT" "POINTER" "STRING" "STRING")
+ − 110 ("INT" "POINTER" "STRING")
+ − 111 ("INT" "POINTER")
+ − 112 ("INT" "STRING" "STRING" "INT" "ARRAY")
+ − 113 ("INT" "STRING")
+ − 114 ("INT")
+ − 115 ("LIST" "OBJECT")
+ − 116 ("LIST")
+ − 117 ("NONE" "BOOL")
+ − 118 ("NONE" "INT" "INT" "INT" "INT")
+ − 119 ("NONE" "INT" "INT")
+ − 120 ("NONE" "INT")
+ − 121 ("NONE" "OBJECT" "BOOL" "INT")
+ − 122 ("NONE" "OBJECT" "BOOL")
+ − 123 ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT" "BOOL")
+ − 124 ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
+ − 125 ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT")
+ − 126 ("NONE" "OBJECT" "FLOAT" "FLOAT")
+ − 127 ("NONE" "OBJECT" "FLOAT")
+ − 128 ("NONE" "OBJECT" "INT" "BOOL")
+ − 129 ("NONE" "OBJECT" "INT" "FLOAT" "BOOL")
+ − 130 ("NONE" "OBJECT" "INT" "FLOAT")
+ − 131 ("NONE" "OBJECT" "INT" "INT" "ARRAY" "ARRAY" "ARRAY" "ARRAY" "ARRAY" "ARRAY")
+ − 132 ("NONE" "OBJECT" "INT" "INT" "ARRAY")
+ − 133 ("NONE" "OBJECT" "INT" "INT" "FLOAT" "FLOAT")
+ − 134 ("NONE" "OBJECT" "INT" "INT" "INT" "INT")
+ − 135 ("NONE" "OBJECT" "INT" "INT" "INT")
+ − 136 ("NONE" "OBJECT" "INT" "INT" "POINTER" "POINTER")
+ − 137 ("NONE" "OBJECT" "INT" "INT" "POINTER")
+ − 138 ("NONE" "OBJECT" "INT" "INT" "STRING" "INT" "POINTER" "POINTER")
+ − 139 ("NONE" "OBJECT" "INT" "INT" "STRING")
+ − 140 ("NONE" "OBJECT" "INT" "INT")
+ − 141 ("NONE" "OBJECT" "INT" "OBJECT")
+ − 142 ("NONE" "OBJECT" "INT" "POINTER")
+ − 143 ("NONE" "OBJECT" "INT" "STRING")
+ − 144 ("NONE" "OBJECT" "INT")
+ − 145 ("NONE" "OBJECT" "LIST" "INT")
+ − 146 ("NONE" "OBJECT" "LIST")
+ − 147 ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL" "INT" "INT")
+ − 148 ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL" "INT")
+ − 149 ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL")
+ − 150 ("NONE" "OBJECT" "OBJECT" "FLOAT" "INT")
+ − 151 ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT" "INT" "INT" "INT" "INT" "INT")
+ − 152 ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT" "INT")
+ − 153 ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT")
+ − 154 ("NONE" "OBJECT" "OBJECT" "INT" "INT")
+ − 155 ("NONE" "OBJECT" "OBJECT" "INT")
+ − 156 ("NONE" "OBJECT" "OBJECT" "OBJECT" "INT")
+ − 157 ("NONE" "OBJECT" "OBJECT" "OBJECT" "OBJECT" "INT")
+ − 158 ("NONE" "OBJECT" "OBJECT" "OBJECT" "OBJECT")
+ − 159 ("NONE" "OBJECT" "OBJECT" "OBJECT" "POINTER" "POINTER" "INT" "INT")
+ − 160 ("NONE" "OBJECT" "OBJECT" "OBJECT")
+ − 161 ("NONE" "OBJECT" "OBJECT" "POINTER")
+ − 162 ("NONE" "OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT" "INT")
+ − 163 ("NONE" "OBJECT" "OBJECT" "STRING" "STRING" "INT")
+ − 164 ("NONE" "OBJECT" "OBJECT" "STRING" "STRING")
+ − 165 ("NONE" "OBJECT" "OBJECT" "STRING")
+ − 166 ("NONE" "OBJECT" "OBJECT")
+ − 167 ("NONE" "OBJECT" "POINTER" "BOOL")
+ − 168 ("NONE" "OBJECT" "POINTER" "INT" "FLOAT" "FLOAT")
+ − 169 ("NONE" "OBJECT" "POINTER" "INT" "INT" "INT")
+ − 170 ("NONE" "OBJECT" "POINTER" "INT" "INT")
+ − 171 ("NONE" "OBJECT" "POINTER" "INT" "POINTER" "POINTER")
+ − 172 ("NONE" "OBJECT" "POINTER" "INT" "POINTER")
+ − 173 ("NONE" "OBJECT" "POINTER" "INT" "STRING" "INT" "POINTER" "POINTER")
+ − 174 ("NONE" "OBJECT" "POINTER" "INT" "STRING")
+ − 175 ("NONE" "OBJECT" "POINTER" "INT")
+ − 176 ("NONE" "OBJECT" "POINTER" "POINTER" "INT" "INT" "INT" "INT" "INT" "INT")
+ − 177 ("NONE" "OBJECT" "POINTER" "POINTER" "POINTER" "STRING" "INT")
+ − 178 ("NONE" "OBJECT" "POINTER" "POINTER" "POINTER")
+ − 179 ("NONE" "OBJECT" "POINTER" "POINTER")
+ − 180 ("NONE" "OBJECT" "POINTER" "STRING" "INT" "POINTER" "POINTER" "POINTER" "POINTER" "BOOL" "BOOL")
+ − 181 ("NONE" "OBJECT" "POINTER")
+ − 182 ("NONE" "OBJECT" "STRING" "BOOL")
+ − 183 ("NONE" "OBJECT" "STRING" "INT" "INT" "INT")
+ − 184 ("NONE" "OBJECT" "STRING" "POINTER" "INT" "INT" "INT")
+ − 185 ("NONE" "OBJECT" "STRING" "POINTER" "INT" "INT")
+ − 186 ("NONE" "OBJECT" "STRING" "STRING")
+ − 187 ("NONE" "OBJECT" "STRING")
+ − 188 ("NONE" "OBJECT")
833
+ − 189 ("NONE" "POINTER" "INT" "INT")
462
+ − 190 ("NONE" "POINTER" "INT")
+ − 191 ("NONE" "POINTER" "POINTER" "BOOL" "INT" "INT" "INT" "INT" "INT" "INT")
+ − 192 ("NONE" "POINTER" "POINTER" "BOOL" "INT" "INT" "INT" "INT")
+ − 193 ("NONE" "POINTER" "POINTER" "INT" "INT" "INT" "INT")
+ − 194 ("NONE" "POINTER" "POINTER" "INT" "INT")
+ − 195 ("NONE" "POINTER" "POINTER" "POINTER" "INT" "INT" "STRING" "INT")
+ − 196 ("NONE" "POINTER" "POINTER" "POINTER" "INT" "INT" "STRING")
+ − 197 ("NONE" "POINTER" "POINTER" "POINTER" "POINTER")
+ − 198 ("NONE" "POINTER" "POINTER")
+ − 199 ("NONE" "POINTER" "STRING" "STRING")
+ − 200 ("NONE" "POINTER" "STRING")
+ − 201 ("NONE" "POINTER")
+ − 202 ("NONE")
+ − 203 ("OBJECT" "BOOL" "BOOL" "INT")
+ − 204 ("OBJECT" "BOOL" "INT")
+ − 205 ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
+ − 206 ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
+ − 207 ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
+ − 208 ("OBJECT" "INT" "ARRAY")
+ − 209 ("OBJECT" "INT" "BOOL" "BOOL")
+ − 210 ("OBJECT" "INT" "INT" "ARRAY")
+ − 211 ("OBJECT" "INT" "INT" "BOOL")
+ − 212 ("OBJECT" "INT" "INT" "STRING")
+ − 213 ("OBJECT" "INT" "INT")
+ − 214 ("OBJECT" "INT")
+ − 215 ("OBJECT" "OBJECT" "FLOAT" "INT")
+ − 216 ("OBJECT" "OBJECT" "INT")
+ − 217 ("OBJECT" "OBJECT" "OBJECT")
+ − 218 ("OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT" "INT")
+ − 219 ("OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT")
+ − 220 ("OBJECT" "OBJECT" "STRING" "INT" "INT")
+ − 221 ("OBJECT" "OBJECT" "STRING")
+ − 222 ("OBJECT" "OBJECT")
+ − 223 ("OBJECT" "POINTER" "POINTER")
+ − 224 ("OBJECT" "POINTER" "STRING")
+ − 225 ("OBJECT" "POINTER")
+ − 226 ("OBJECT" "STRING" "FLOAT" "FLOAT" "FLOAT" "BOOL")
+ − 227 ("OBJECT" "STRING" "INT" "STRING" "STRING")
+ − 228 ("OBJECT" "STRING" "OBJECT")
+ − 229 ("OBJECT" "STRING" "STRING" "STRING" "ARRAY" "STRING" "STRING")
+ − 230 ("OBJECT" "STRING" "STRING")
+ − 231 ("OBJECT" "STRING")
+ − 232 ("OBJECT")
+ − 233 ("POINTER" "INT" "INT")
+ − 234 ("POINTER" "INT")
+ − 235 ("POINTER" "OBJECT" "INT" "INT")
+ − 236 ("POINTER" "OBJECT" "INT")
+ − 237 ("POINTER" "OBJECT" "POINTER" "INT")
+ − 238 ("POINTER" "OBJECT" "POINTER" "POINTER" "ARRAY" "INT" "POINTER" "POINTER" "POINTER" "POINTER" "BOOL" "BOOL")
+ − 239 ("POINTER" "OBJECT" "POINTER")
+ − 240 ("POINTER" "OBJECT")
+ − 241 ("POINTER" "POINTER")
833
+ − 242 ("POINTER" "STRING" "INT")
462
+ − 243 ("POINTER")
+ − 244 ("STRING" "INT" "INT" "INT")
+ − 245 ("STRING" "INT")
+ − 246 ("STRING" "OBJECT" "BOOL")
+ − 247 ("STRING" "OBJECT" "FLOAT")
+ − 248 ("STRING" "OBJECT" "INT" "INT")
+ − 249 ("STRING" "OBJECT" "INT")
+ − 250 ("STRING" "OBJECT")
+ − 251 ("STRING" "POINTER" "STRING")
+ − 252 ("STRING" "POINTER")
+ − 253 ("STRING")
+ − 254 )
+ − 255 )
+ − 256 )
+ − 257 (mapc (lambda (x) (apply 'define-marshaller x)) todo)
+ − 258
+ − 259 (insert "\n
+ − 260 #include \"hash.h\"
608
+ − 261 static int
+ − 262 our_string_eq (const void *st1, const void *st2)
+ − 263 {
+ − 264 if (!st1)
+ − 265 return st2 ? 0 : 1;
+ − 266 else if (!st2)
+ − 267 return 0;
+ − 268 else
+ − 269 return !strcmp ( (const char *) st1, (const char *) st2);
+ − 270 }
+ − 271
833
+ − 272 static unsigned long
608
+ − 273 our_string_hash (const void *xv)
+ − 274 {
+ − 275 unsigned int h = 0;
+ − 276 unsigned const char *x = (unsigned const char *) xv;
+ − 277
+ − 278 if (!x) return 0;
+ − 279
+ − 280 while (*x)
+ − 281 {
+ − 282 unsigned int g;
+ − 283 h = (h << 4) + *x++;
+ − 284 if ((g = h & 0xf0000000) != 0)
+ − 285 h = (h ^ (g >> 24)) ^ g;
+ − 286 }
+ − 287
+ − 288 return h;
+ − 289 }
+ − 290
+ − 291 static struct hash_table *marshaller_hashtable;
462
+ − 292
+ − 293 static void initialize_marshaller_storage (void)
+ − 294 {
+ − 295 if (!marshaller_hashtable)
+ − 296 {
608
+ − 297 marshaller_hashtable = make_general_hash_table (100, our_string_hash, our_string_eq);
462
+ − 298 ")
+ − 299
+ − 300 (mapc (lambda (x)
+ − 301 (let ((name (get-marshaller-name (car x) (cdr x))))
+ − 302 (insert (format "\t\tputhash (\"%s\", (void *) %s, marshaller_hashtable);\n" name name))))
+ − 303 todo)
+ − 304 (insert "\t};\n"
+ − 305 "}\n"
+ − 306 "
+ − 307 static void *find_marshaller (const char *func_name)
+ − 308 {
+ − 309 void *fn = NULL;
+ − 310 initialize_marshaller_storage ();
+ − 311
591
+ − 312 if (gethash (func_name, marshaller_hashtable, (const void **)&fn))
462
+ − 313 {
+ − 314 return (fn);
+ − 315 }
+ − 316
+ − 317 return (NULL);
+ − 318 }
+ − 319 "))
+ − 320
+ − 321 (save-buffer)
+ − 322 (kill-buffer "emacs-marshals.c"))