Mercurial > hg > xemacs-beta
annotate lisp/gtk-marshal.el @ 5883:d93195c2c906
Escape quotation marks when printing values interactively, #'getenv
src/ChangeLog addition:
2015-04-01 Aidan Kehoe <kehoea@parhasard.net>
* process.c (Fgetenv):
When interactively showing a variable's value, use %S in the
format string so quotation marks are escaped correctly.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Fri, 03 Apr 2015 00:15:18 +0100 |
parents | b9167d522a9a |
children |
rev | line source |
---|---|
5287
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
1 ;; gtk-marshal.el --- regenerate C wrappers for GTK |
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
2 ;; |
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
3 ;; Copyright (C) 2000, 2001 William M. Perry |
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
4 ;; |
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2523
diff
changeset
|
5 ;; This file is part of XEmacs. |
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
6 |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
7 ;; XEmacs is free software: you can redistribute it and/or modify it |
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2523
diff
changeset
|
8 ;; under the terms of the GNU General Public License as published by the |
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
9 ;; Free Software Foundation, either version 3 of the License, or (at your |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
10 ;; option) any later version. |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
11 |
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2523
diff
changeset
|
12 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2523
diff
changeset
|
13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2523
diff
changeset
|
14 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2523
diff
changeset
|
15 ;; for more details. |
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
16 |
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2523
diff
changeset
|
17 ;; You should have received a copy of the GNU General Public License |
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
18 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
2054 | 19 ;; |
20 ;; To regenerate ../src/emacs-marshals.c just load this file. | |
21 ;; | |
462 | 22 (defconst name-to-return-type |
2054 | 23 '(("INT" . "gint") |
462 | 24 ("CALLBACK" . "GtkCallback") |
25 ("OBJECT" . "GtkObject *") | |
26 ("POINTER" . "void *") | |
27 ("STRING" . "gchar *") | |
28 ("BOOL" . "gboolean") | |
29 ("DOUBLE" . "gdouble") | |
30 ("FLOAT" . "gfloat") | |
31 ("LIST" . "void *") | |
32 ("NONE" . nil))) | |
33 | |
34 (defvar defined-marshallers nil) | |
35 | |
36 (defun get-marshaller-name (rval args) | |
37 (concat "emacs_gtk_marshal_" rval "__" | |
38 (mapconcat 'identity (or args '("NONE")) "_"))) | |
39 | |
40 (defun define-marshaller (rval &rest args) | |
41 (let ((name nil) | |
42 (internal-rval (assoc rval name-to-return-type)) | |
43 (ctr 0) | |
44 (func-proto (format "__%s_fn" rval))) | |
45 (if (not internal-rval) | |
46 (error "Do not know return type of `%s'" rval)) | |
47 (setq name (get-marshaller-name rval args)) | |
48 | |
49 (if (member name defined-marshallers) | |
2054 | 50 (error "Attempt to define the same marshaller more than once! %s" name)) |
462 | 51 |
52 (set-buffer (get-buffer-create "emacs-marshals.c")) | |
53 (goto-char (point-max)) | |
54 | |
55 (if (or (member "FLOAT" args) (member "DOUBLE" args)) | |
56 ;; We need to special case anything with FLOAT in the argument | |
57 ;; list or the parameters get screwed up royally. | |
58 (progn | |
59 (setq func-proto (concat (format "__%s__" rval) | |
60 (mapconcat 'identity args "_") | |
61 "_fn")) | |
62 (insert "typedef " | |
63 (or (cdr internal-rval) "void") | |
64 " (*" | |
65 func-proto ")(" | |
66 (mapconcat (lambda (x) | |
67 (cdr (assoc x name-to-return-type))) args ", ") | |
68 ");\n"))) | |
69 | |
70 (insert "\n" | |
71 "static void\n" | |
72 name " (ffi_actual_function func, GtkArg *args)\n" | |
73 "{\n" | |
74 (format " %s rfunc = (%s) func;\n" func-proto func-proto)) | |
75 | |
76 (if (string= "LIST" rval) (setq rval "POINTER")) | |
77 | |
78 (if (cdr internal-rval) | |
79 ;; It has a return type to worry about | |
80 (insert " " (cdr internal-rval) " *return_val;\n\n" | |
81 (format " return_val = GTK_RETLOC_%s (args[%d]);\n" rval (length args)) | |
82 " *return_val = ") | |
83 (insert " ")) | |
84 (insert "(*rfunc) (") | |
85 (while args | |
86 (if (/= ctr 0) | |
87 (insert ", ")) | |
88 (insert (format "GTK_VALUE_%s (args[%d])" (car args) ctr)) | |
89 (setq args (cdr args) | |
90 ctr (1+ ctr))) | |
91 (insert ");\n") | |
92 (insert "}\n"))) | |
93 | |
94 (save-excursion | |
591 | 95 (find-file "../src/emacs-marshals.c") |
462 | 96 (erase-buffer) |
97 (setq defined-marshallers nil) | |
98 | |
591 | 99 (insert "/* This file was automatically generated by ../lisp/gtk-marshal.el */\n" |
100 "/* DO NOT EDIT BY HAND!!! */\n") | |
462 | 101 (insert "#define GTK_VALUE_ARRAY(x) GTK_VALUE_POINTER(x)\n\n") |
102 (insert "#define GTK_VALUE_LIST(x) GTK_VALUE_POINTER(x)\n\n") | |
103 | |
104 (let ((todo '( | |
105 ("BOOL" "OBJECT" "INT") | |
106 ("BOOL" "OBJECT" "OBJECT" "OBJECT") | |
107 ("BOOL" "OBJECT" "OBJECT") | |
108 ("BOOL" "OBJECT" "POINTER") | |
109 ("BOOL" "OBJECT" "STRING") | |
110 ("BOOL" "OBJECT") | |
111 ("BOOL" "POINTER" "BOOL") | |
112 ("BOOL" "POINTER") | |
113 ("BOOL") | |
114 ("FLOAT" "OBJECT" "FLOAT") | |
115 ("FLOAT" "OBJECT") | |
116 ("INT" "BOOL") | |
117 ("INT" "OBJECT" "ARRAY") | |
118 ("INT" "OBJECT" "INT" "ARRAY") | |
119 ("INT" "OBJECT" "INT" "INT") | |
120 ("INT" "OBJECT" "INT" "STRING") | |
121 ("INT" "OBJECT" "INT") | |
122 ("INT" "OBJECT" "OBJECT") | |
123 ("INT" "OBJECT" "POINTER" "INT" "INT") | |
124 ("INT" "OBJECT" "POINTER" "INT") | |
125 ("INT" "OBJECT" "POINTER") | |
126 ("INT" "OBJECT" "STRING") | |
127 ("INT" "OBJECT") | |
128 ("INT" "POINTER" "INT") | |
129 ("INT" "POINTER" "STRING" "INT") | |
130 ("INT" "POINTER" "STRING" "STRING") | |
131 ("INT" "POINTER" "STRING") | |
132 ("INT" "POINTER") | |
133 ("INT" "STRING" "STRING" "INT" "ARRAY") | |
134 ("INT" "STRING") | |
135 ("INT") | |
136 ("LIST" "OBJECT") | |
137 ("LIST") | |
138 ("NONE" "BOOL") | |
139 ("NONE" "INT" "INT" "INT" "INT") | |
140 ("NONE" "INT" "INT") | |
141 ("NONE" "INT") | |
142 ("NONE" "OBJECT" "BOOL" "INT") | |
143 ("NONE" "OBJECT" "BOOL") | |
144 ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT" "BOOL") | |
145 ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT") | |
146 ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT") | |
147 ("NONE" "OBJECT" "FLOAT" "FLOAT") | |
148 ("NONE" "OBJECT" "FLOAT") | |
149 ("NONE" "OBJECT" "INT" "BOOL") | |
150 ("NONE" "OBJECT" "INT" "FLOAT" "BOOL") | |
151 ("NONE" "OBJECT" "INT" "FLOAT") | |
152 ("NONE" "OBJECT" "INT" "INT" "ARRAY" "ARRAY" "ARRAY" "ARRAY" "ARRAY" "ARRAY") | |
153 ("NONE" "OBJECT" "INT" "INT" "ARRAY") | |
154 ("NONE" "OBJECT" "INT" "INT" "FLOAT" "FLOAT") | |
155 ("NONE" "OBJECT" "INT" "INT" "INT" "INT") | |
156 ("NONE" "OBJECT" "INT" "INT" "INT") | |
157 ("NONE" "OBJECT" "INT" "INT" "POINTER" "POINTER") | |
158 ("NONE" "OBJECT" "INT" "INT" "POINTER") | |
159 ("NONE" "OBJECT" "INT" "INT" "STRING" "INT" "POINTER" "POINTER") | |
160 ("NONE" "OBJECT" "INT" "INT" "STRING") | |
161 ("NONE" "OBJECT" "INT" "INT") | |
162 ("NONE" "OBJECT" "INT" "OBJECT") | |
163 ("NONE" "OBJECT" "INT" "POINTER") | |
164 ("NONE" "OBJECT" "INT" "STRING") | |
165 ("NONE" "OBJECT" "INT") | |
166 ("NONE" "OBJECT" "LIST" "INT") | |
167 ("NONE" "OBJECT" "LIST") | |
168 ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL" "INT" "INT") | |
169 ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL" "INT") | |
170 ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL") | |
171 ("NONE" "OBJECT" "OBJECT" "FLOAT" "INT") | |
172 ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT" "INT" "INT" "INT" "INT" "INT") | |
173 ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT" "INT") | |
174 ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT") | |
175 ("NONE" "OBJECT" "OBJECT" "INT" "INT") | |
176 ("NONE" "OBJECT" "OBJECT" "INT") | |
177 ("NONE" "OBJECT" "OBJECT" "OBJECT" "INT") | |
178 ("NONE" "OBJECT" "OBJECT" "OBJECT" "OBJECT" "INT") | |
179 ("NONE" "OBJECT" "OBJECT" "OBJECT" "OBJECT") | |
180 ("NONE" "OBJECT" "OBJECT" "OBJECT" "POINTER" "POINTER" "INT" "INT") | |
181 ("NONE" "OBJECT" "OBJECT" "OBJECT") | |
182 ("NONE" "OBJECT" "OBJECT" "POINTER") | |
183 ("NONE" "OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT" "INT") | |
184 ("NONE" "OBJECT" "OBJECT" "STRING" "STRING" "INT") | |
185 ("NONE" "OBJECT" "OBJECT" "STRING" "STRING") | |
186 ("NONE" "OBJECT" "OBJECT" "STRING") | |
187 ("NONE" "OBJECT" "OBJECT") | |
188 ("NONE" "OBJECT" "POINTER" "BOOL") | |
189 ("NONE" "OBJECT" "POINTER" "INT" "FLOAT" "FLOAT") | |
190 ("NONE" "OBJECT" "POINTER" "INT" "INT" "INT") | |
191 ("NONE" "OBJECT" "POINTER" "INT" "INT") | |
192 ("NONE" "OBJECT" "POINTER" "INT" "POINTER" "POINTER") | |
193 ("NONE" "OBJECT" "POINTER" "INT" "POINTER") | |
194 ("NONE" "OBJECT" "POINTER" "INT" "STRING" "INT" "POINTER" "POINTER") | |
195 ("NONE" "OBJECT" "POINTER" "INT" "STRING") | |
196 ("NONE" "OBJECT" "POINTER" "INT") | |
197 ("NONE" "OBJECT" "POINTER" "POINTER" "INT" "INT" "INT" "INT" "INT" "INT") | |
198 ("NONE" "OBJECT" "POINTER" "POINTER" "POINTER" "STRING" "INT") | |
199 ("NONE" "OBJECT" "POINTER" "POINTER" "POINTER") | |
200 ("NONE" "OBJECT" "POINTER" "POINTER") | |
201 ("NONE" "OBJECT" "POINTER" "STRING" "INT" "POINTER" "POINTER" "POINTER" "POINTER" "BOOL" "BOOL") | |
202 ("NONE" "OBJECT" "POINTER") | |
203 ("NONE" "OBJECT" "STRING" "BOOL") | |
204 ("NONE" "OBJECT" "STRING" "INT" "INT" "INT") | |
205 ("NONE" "OBJECT" "STRING" "POINTER" "INT" "INT" "INT") | |
206 ("NONE" "OBJECT" "STRING" "POINTER" "INT" "INT") | |
207 ("NONE" "OBJECT" "STRING" "STRING") | |
208 ("NONE" "OBJECT" "STRING") | |
209 ("NONE" "OBJECT") | |
833 | 210 ("NONE" "POINTER" "INT" "INT") |
462 | 211 ("NONE" "POINTER" "INT") |
212 ("NONE" "POINTER" "POINTER" "BOOL" "INT" "INT" "INT" "INT" "INT" "INT") | |
213 ("NONE" "POINTER" "POINTER" "BOOL" "INT" "INT" "INT" "INT") | |
214 ("NONE" "POINTER" "POINTER" "INT" "INT" "INT" "INT") | |
215 ("NONE" "POINTER" "POINTER" "INT" "INT") | |
216 ("NONE" "POINTER" "POINTER" "POINTER" "INT" "INT" "STRING" "INT") | |
217 ("NONE" "POINTER" "POINTER" "POINTER" "INT" "INT" "STRING") | |
218 ("NONE" "POINTER" "POINTER" "POINTER" "POINTER") | |
219 ("NONE" "POINTER" "POINTER") | |
220 ("NONE" "POINTER" "STRING" "STRING") | |
221 ("NONE" "POINTER" "STRING") | |
222 ("NONE" "POINTER") | |
223 ("NONE") | |
224 ("OBJECT" "BOOL" "BOOL" "INT") | |
225 ("OBJECT" "BOOL" "INT") | |
226 ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT") | |
227 ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT") | |
228 ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT") | |
229 ("OBJECT" "INT" "ARRAY") | |
230 ("OBJECT" "INT" "BOOL" "BOOL") | |
231 ("OBJECT" "INT" "INT" "ARRAY") | |
232 ("OBJECT" "INT" "INT" "BOOL") | |
233 ("OBJECT" "INT" "INT" "STRING") | |
234 ("OBJECT" "INT" "INT") | |
235 ("OBJECT" "INT") | |
236 ("OBJECT" "OBJECT" "FLOAT" "INT") | |
237 ("OBJECT" "OBJECT" "INT") | |
238 ("OBJECT" "OBJECT" "OBJECT") | |
239 ("OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT" "INT") | |
240 ("OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT") | |
241 ("OBJECT" "OBJECT" "STRING" "INT" "INT") | |
242 ("OBJECT" "OBJECT" "STRING") | |
243 ("OBJECT" "OBJECT") | |
244 ("OBJECT" "POINTER" "POINTER") | |
245 ("OBJECT" "POINTER" "STRING") | |
246 ("OBJECT" "POINTER") | |
247 ("OBJECT" "STRING" "FLOAT" "FLOAT" "FLOAT" "BOOL") | |
248 ("OBJECT" "STRING" "INT" "STRING" "STRING") | |
249 ("OBJECT" "STRING" "OBJECT") | |
250 ("OBJECT" "STRING" "STRING" "STRING" "ARRAY" "STRING" "STRING") | |
251 ("OBJECT" "STRING" "STRING") | |
252 ("OBJECT" "STRING") | |
253 ("OBJECT") | |
254 ("POINTER" "INT" "INT") | |
255 ("POINTER" "INT") | |
256 ("POINTER" "OBJECT" "INT" "INT") | |
257 ("POINTER" "OBJECT" "INT") | |
258 ("POINTER" "OBJECT" "POINTER" "INT") | |
259 ("POINTER" "OBJECT" "POINTER" "POINTER" "ARRAY" "INT" "POINTER" "POINTER" "POINTER" "POINTER" "BOOL" "BOOL") | |
260 ("POINTER" "OBJECT" "POINTER") | |
261 ("POINTER" "OBJECT") | |
262 ("POINTER" "POINTER") | |
833 | 263 ("POINTER" "STRING" "INT") |
462 | 264 ("POINTER") |
265 ("STRING" "INT" "INT" "INT") | |
266 ("STRING" "INT") | |
267 ("STRING" "OBJECT" "BOOL") | |
268 ("STRING" "OBJECT" "FLOAT") | |
269 ("STRING" "OBJECT" "INT" "INT") | |
270 ("STRING" "OBJECT" "INT") | |
271 ("STRING" "OBJECT") | |
272 ("STRING" "POINTER" "STRING") | |
273 ("STRING" "POINTER") | |
274 ("STRING") | |
275 ) | |
276 ) | |
277 ) | |
278 (mapc (lambda (x) (apply 'define-marshaller x)) todo) | |
279 | |
280 (insert "\n | |
281 #include \"hash.h\" | |
608 | 282 |
283 static struct hash_table *marshaller_hashtable; | |
462 | 284 |
285 static void initialize_marshaller_storage (void) | |
286 { | |
287 if (!marshaller_hashtable) | |
288 { | |
2523 | 289 marshaller_hashtable = make_string_hash_table (100); |
462 | 290 ") |
291 | |
292 (mapc (lambda (x) | |
293 (let ((name (get-marshaller-name (car x) (cdr x)))) | |
294 (insert (format "\t\tputhash (\"%s\", (void *) %s, marshaller_hashtable);\n" name name)))) | |
295 todo) | |
296 (insert "\t};\n" | |
297 "}\n" | |
298 " | |
299 static void *find_marshaller (const char *func_name) | |
300 { | |
301 void *fn = NULL; | |
302 initialize_marshaller_storage (); | |
303 | |
591 | 304 if (gethash (func_name, marshaller_hashtable, (const void **)&fn)) |
462 | 305 { |
306 return (fn); | |
307 } | |
308 | |
309 return (NULL); | |
310 } | |
311 ")) | |
312 | |
313 (save-buffer) | |
314 (kill-buffer "emacs-marshals.c")) |