1 (defconst name-to-return-type
3 ("CALLBACK" . "GtkCallback")
4 ("OBJECT" . "GtkObject *")
13 (defvar defined-marshallers nil)
15 (defun get-marshaller-name (rval args)
16 (concat "emacs_gtk_marshal_" rval "__"
17 (mapconcat 'identity (or args '("NONE")) "_")))
19 (defun define-marshaller (rval &rest args)
21 (internal-rval (assoc rval name-to-return-type))
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))
28 (if (member name defined-marshallers)
29 (error "Attempe to define the same marshaller more than once! %s" name))
31 (set-buffer (get-buffer-create "emacs-marshals.c"))
32 (goto-char (point-max))
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.
38 (setq func-proto (concat (format "__%s__" rval)
39 (mapconcat 'identity args "_")
42 (or (cdr internal-rval) "void")
45 (mapconcat (lambda (x)
46 (cdr (assoc x name-to-return-type))) args ", ")
51 name " (ffi_actual_function func, GtkArg *args)\n"
53 (format " %s rfunc = (%s) func;\n" func-proto func-proto))
55 (if (string= "LIST" rval) (setq rval "POINTER"))
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))
67 (insert (format "GTK_VALUE_%s (args[%d])" (car args) ctr))
74 (find-file "../../src/emacs-marshals.c")
76 (setq defined-marshallers nil)
78 (insert "#define GTK_VALUE_ARRAY(x) GTK_VALUE_POINTER(x)\n\n")
79 (insert "#define GTK_VALUE_LIST(x) GTK_VALUE_POINTER(x)\n\n")
82 ("BOOL" "OBJECT" "INT")
83 ("BOOL" "OBJECT" "OBJECT" "OBJECT")
84 ("BOOL" "OBJECT" "OBJECT")
85 ("BOOL" "OBJECT" "POINTER")
86 ("BOOL" "OBJECT" "STRING")
88 ("BOOL" "POINTER" "BOOL")
91 ("FLOAT" "OBJECT" "FLOAT")
94 ("INT" "OBJECT" "ARRAY")
95 ("INT" "OBJECT" "INT" "ARRAY")
96 ("INT" "OBJECT" "INT" "INT")
97 ("INT" "OBJECT" "INT" "STRING")
98 ("INT" "OBJECT" "INT")
99 ("INT" "OBJECT" "OBJECT")
100 ("INT" "OBJECT" "POINTER" "INT" "INT")
101 ("INT" "OBJECT" "POINTER" "INT")
102 ("INT" "OBJECT" "POINTER")
103 ("INT" "OBJECT" "STRING")
105 ("INT" "POINTER" "INT")
106 ("INT" "POINTER" "STRING" "INT")
107 ("INT" "POINTER" "STRING" "STRING")
108 ("INT" "POINTER" "STRING")
110 ("INT" "STRING" "STRING" "INT" "ARRAY")
116 ("NONE" "INT" "INT" "INT" "INT")
119 ("NONE" "OBJECT" "BOOL" "INT")
120 ("NONE" "OBJECT" "BOOL")
121 ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT" "BOOL")
122 ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
123 ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT")
124 ("NONE" "OBJECT" "FLOAT" "FLOAT")
125 ("NONE" "OBJECT" "FLOAT")
126 ("NONE" "OBJECT" "INT" "BOOL")
127 ("NONE" "OBJECT" "INT" "FLOAT" "BOOL")
128 ("NONE" "OBJECT" "INT" "FLOAT")
129 ("NONE" "OBJECT" "INT" "INT" "ARRAY" "ARRAY" "ARRAY" "ARRAY" "ARRAY" "ARRAY")
130 ("NONE" "OBJECT" "INT" "INT" "ARRAY")
131 ("NONE" "OBJECT" "INT" "INT" "FLOAT" "FLOAT")
132 ("NONE" "OBJECT" "INT" "INT" "INT" "INT")
133 ("NONE" "OBJECT" "INT" "INT" "INT")
134 ("NONE" "OBJECT" "INT" "INT" "POINTER" "POINTER")
135 ("NONE" "OBJECT" "INT" "INT" "POINTER")
136 ("NONE" "OBJECT" "INT" "INT" "STRING" "INT" "POINTER" "POINTER")
137 ("NONE" "OBJECT" "INT" "INT" "STRING")
138 ("NONE" "OBJECT" "INT" "INT")
139 ("NONE" "OBJECT" "INT" "OBJECT")
140 ("NONE" "OBJECT" "INT" "POINTER")
141 ("NONE" "OBJECT" "INT" "STRING")
142 ("NONE" "OBJECT" "INT")
143 ("NONE" "OBJECT" "LIST" "INT")
144 ("NONE" "OBJECT" "LIST")
145 ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL" "INT" "INT")
146 ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL" "INT")
147 ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL")
148 ("NONE" "OBJECT" "OBJECT" "FLOAT" "INT")
149 ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT" "INT" "INT" "INT" "INT" "INT")
150 ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT" "INT")
151 ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT")
152 ("NONE" "OBJECT" "OBJECT" "INT" "INT")
153 ("NONE" "OBJECT" "OBJECT" "INT")
154 ("NONE" "OBJECT" "OBJECT" "OBJECT" "INT")
155 ("NONE" "OBJECT" "OBJECT" "OBJECT" "OBJECT" "INT")
156 ("NONE" "OBJECT" "OBJECT" "OBJECT" "OBJECT")
157 ("NONE" "OBJECT" "OBJECT" "OBJECT" "POINTER" "POINTER" "INT" "INT")
158 ("NONE" "OBJECT" "OBJECT" "OBJECT")
159 ("NONE" "OBJECT" "OBJECT" "POINTER")
160 ("NONE" "OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT" "INT")
161 ("NONE" "OBJECT" "OBJECT" "STRING" "STRING" "INT")
162 ("NONE" "OBJECT" "OBJECT" "STRING" "STRING")
163 ("NONE" "OBJECT" "OBJECT" "STRING")
164 ("NONE" "OBJECT" "OBJECT")
165 ("NONE" "OBJECT" "POINTER" "BOOL")
166 ("NONE" "OBJECT" "POINTER" "INT" "FLOAT" "FLOAT")
167 ("NONE" "OBJECT" "POINTER" "INT" "INT" "INT")
168 ("NONE" "OBJECT" "POINTER" "INT" "INT")
169 ("NONE" "OBJECT" "POINTER" "INT" "POINTER" "POINTER")
170 ("NONE" "OBJECT" "POINTER" "INT" "POINTER")
171 ("NONE" "OBJECT" "POINTER" "INT" "STRING" "INT" "POINTER" "POINTER")
172 ("NONE" "OBJECT" "POINTER" "INT" "STRING")
173 ("NONE" "OBJECT" "POINTER" "INT")
174 ("NONE" "OBJECT" "POINTER" "POINTER" "INT" "INT" "INT" "INT" "INT" "INT")
175 ("NONE" "OBJECT" "POINTER" "POINTER" "POINTER" "STRING" "INT")
176 ("NONE" "OBJECT" "POINTER" "POINTER" "POINTER")
177 ("NONE" "OBJECT" "POINTER" "POINTER")
178 ("NONE" "OBJECT" "POINTER" "STRING" "INT" "POINTER" "POINTER" "POINTER" "POINTER" "BOOL" "BOOL")
179 ("NONE" "OBJECT" "POINTER")
180 ("NONE" "OBJECT" "STRING" "BOOL")
181 ("NONE" "OBJECT" "STRING" "INT" "INT" "INT")
182 ("NONE" "OBJECT" "STRING" "POINTER" "INT" "INT" "INT")
183 ("NONE" "OBJECT" "STRING" "POINTER" "INT" "INT")
184 ("NONE" "OBJECT" "STRING" "STRING")
185 ("NONE" "OBJECT" "STRING")
187 ("NONE" "POINTER" "INT")
188 ("NONE" "POINTER" "INT" "INT")
189 ("NONE" "POINTER" "POINTER" "BOOL" "INT" "INT" "INT" "INT" "INT" "INT")
190 ("NONE" "POINTER" "POINTER" "BOOL" "INT" "INT" "INT" "INT")
191 ("NONE" "POINTER" "POINTER" "INT" "INT" "INT" "INT")
192 ("NONE" "POINTER" "POINTER" "INT" "INT")
193 ("NONE" "POINTER" "POINTER" "POINTER" "INT" "INT" "STRING" "INT")
194 ("NONE" "POINTER" "POINTER" "POINTER" "INT" "INT" "STRING")
195 ("NONE" "POINTER" "POINTER" "POINTER" "POINTER")
196 ("NONE" "POINTER" "POINTER")
197 ("NONE" "POINTER" "STRING" "STRING")
198 ("NONE" "POINTER" "STRING")
201 ("OBJECT" "BOOL" "BOOL" "INT")
202 ("OBJECT" "BOOL" "INT")
203 ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
204 ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
205 ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
206 ("OBJECT" "INT" "ARRAY")
207 ("OBJECT" "INT" "BOOL" "BOOL")
208 ("OBJECT" "INT" "INT" "ARRAY")
209 ("OBJECT" "INT" "INT" "BOOL")
210 ("OBJECT" "INT" "INT" "STRING")
211 ("OBJECT" "INT" "INT")
213 ("OBJECT" "OBJECT" "FLOAT" "INT")
214 ("OBJECT" "OBJECT" "INT")
215 ("OBJECT" "OBJECT" "OBJECT")
216 ("OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT" "INT")
217 ("OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT")
218 ("OBJECT" "OBJECT" "STRING" "INT" "INT")
219 ("OBJECT" "OBJECT" "STRING")
221 ("OBJECT" "POINTER" "POINTER")
222 ("OBJECT" "POINTER" "STRING")
224 ("OBJECT" "STRING" "FLOAT" "FLOAT" "FLOAT" "BOOL")
225 ("OBJECT" "STRING" "INT" "STRING" "STRING")
226 ("OBJECT" "STRING" "OBJECT")
227 ("OBJECT" "STRING" "STRING" "STRING" "ARRAY" "STRING" "STRING")
228 ("OBJECT" "STRING" "STRING")
231 ("POINTER" "INT" "INT")
233 ("POINTER" "OBJECT" "INT" "INT")
234 ("POINTER" "OBJECT" "INT")
235 ("POINTER" "OBJECT" "POINTER" "INT")
236 ("POINTER" "OBJECT" "POINTER" "POINTER" "ARRAY" "INT" "POINTER" "POINTER" "POINTER" "POINTER" "BOOL" "BOOL")
237 ("POINTER" "OBJECT" "POINTER")
239 ("POINTER" "POINTER")
241 ("STRING" "INT" "INT" "INT")
243 ("STRING" "OBJECT" "BOOL")
244 ("STRING" "OBJECT" "FLOAT")
245 ("STRING" "OBJECT" "INT" "INT")
246 ("STRING" "OBJECT" "INT")
248 ("STRING" "POINTER" "STRING")
254 (mapc (lambda (x) (apply 'define-marshaller x)) todo)
258 static c_hashtable marshaller_hashtable;
260 static void initialize_marshaller_storage (void)
262 if (!marshaller_hashtable)
264 marshaller_hashtable = make_strings_hashtable (100);
268 (let ((name (get-marshaller-name (car x) (cdr x))))
269 (insert (format "\t\tputhash (\"%s\", (void *) %s, marshaller_hashtable);\n" name name))))
274 static void *find_marshaller (const char *func_name)
277 initialize_marshaller_storage ();
279 if (gethash (func_name, marshaller_hashtable, (CONST void **)&fn))
289 (kill-buffer "emacs-marshals.c"))