Mercurial > hg > xemacs-beta
annotate lisp/gtk-marshal.el @ 5892:053ef01b71a8
Import the #'clear-string API from GNU, use it in tls.c
src/ChangeLog addition:
2015-04-18 Aidan Kehoe <kehoea@parhasard.net>
* sequence.c (Fclear_string): New, API from GNU. Zero a string's
contents, making sure the text is not kept around even when the
string's data is reallocated because of a changed character
length.
* sequence.c (syms_of_sequence): Make it available to Lisp.
* lisp.h: Make it available to C code.
* tls.c (nss_pk11_password): Use it.
* tls.c (gnutls_pk11_password): Use it.
* tls.c (openssl_password): Use it.
tests/ChangeLog addition:
2015-04-18 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test #'clear-string, just added. Unfortunately there's no way to
be certain from Lisp that the old password data has been erased
after realloc; it may be worth adding a test to tests.c, but
*we'll be reading memory we shouldn't be*, so that gives me pause.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 18 Apr 2015 23:00:14 +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")) |