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