Mercurial > hg > xemacs-beta
annotate lisp/gtk-marshal.el @ 5458:97968d099404
Replace #'font-hex-string-to-number, #'font-warn with builtins, font.el
2011-04-23 Aidan Kehoe <kehoea@parhasard.net>
* font.el:
* font.el (font-warn): Removed.
* font.el (font-hex-string-to-number): Removed.
* font.el (internal-facep):
* font.el (font-lookup-rgb-components):
* font.el (font-parse-rgb-components):
Use #'string-to-number with the BASE argument instead of
#'font-hex-string-to-number, #'display-warning instead of
#'font-warn.
This entire file smells bitrotted, with lots of functions of very
little relevance to XEmacs, but addressing that is more work than
I can do today.
Lines beginning with 'HG:' are removed.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 23 Apr 2011 16:24:24 +0100 |
| parents | cd167465bf69 |
| children | b9167d522a9a |
| 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. |
|
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
|
6 ;; |
|
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
|
7 ;; XEmacs is free software; you can redistribute it and/or modify it |
|
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 |
|
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
|
9 ;; Free Software Foundation; either version 2, or (at your option) any |
|
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
|
10 ;; later version. |
|
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
|
11 ;; |
|
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. |
|
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
|
16 ;; |
|
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 |
|
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
|
18 ;; along with XEmacs; see the file COPYING. If not, write to |
|
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
|
19 ;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, |
|
5231
ba07c880114a
Fix up FSF's Franklin Street address in many files.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4709
diff
changeset
|
20 ;; Boston, MA 02110-1301, USA. */ |
| 2054 | 21 ;; |
| 22 ;; To regenerate ../src/emacs-marshals.c just load this file. | |
| 23 ;; | |
| 462 | 24 (defconst name-to-return-type |
| 2054 | 25 '(("INT" . "gint") |
| 462 | 26 ("CALLBACK" . "GtkCallback") |
| 27 ("OBJECT" . "GtkObject *") | |
| 28 ("POINTER" . "void *") | |
| 29 ("STRING" . "gchar *") | |
| 30 ("BOOL" . "gboolean") | |
| 31 ("DOUBLE" . "gdouble") | |
| 32 ("FLOAT" . "gfloat") | |
| 33 ("LIST" . "void *") | |
| 34 ("NONE" . nil))) | |
| 35 | |
| 36 (defvar defined-marshallers nil) | |
| 37 | |
| 38 (defun get-marshaller-name (rval args) | |
| 39 (concat "emacs_gtk_marshal_" rval "__" | |
| 40 (mapconcat 'identity (or args '("NONE")) "_"))) | |
| 41 | |
| 42 (defun define-marshaller (rval &rest args) | |
| 43 (let ((name nil) | |
| 44 (internal-rval (assoc rval name-to-return-type)) | |
| 45 (ctr 0) | |
| 46 (func-proto (format "__%s_fn" rval))) | |
| 47 (if (not internal-rval) | |
| 48 (error "Do not know return type of `%s'" rval)) | |
| 49 (setq name (get-marshaller-name rval args)) | |
| 50 | |
| 51 (if (member name defined-marshallers) | |
| 2054 | 52 (error "Attempt to define the same marshaller more than once! %s" name)) |
| 462 | 53 |
| 54 (set-buffer (get-buffer-create "emacs-marshals.c")) | |
| 55 (goto-char (point-max)) | |
| 56 | |
| 57 (if (or (member "FLOAT" args) (member "DOUBLE" args)) | |
| 58 ;; We need to special case anything with FLOAT in the argument | |
| 59 ;; list or the parameters get screwed up royally. | |
| 60 (progn | |
| 61 (setq func-proto (concat (format "__%s__" rval) | |
| 62 (mapconcat 'identity args "_") | |
| 63 "_fn")) | |
| 64 (insert "typedef " | |
| 65 (or (cdr internal-rval) "void") | |
| 66 " (*" | |
| 67 func-proto ")(" | |
| 68 (mapconcat (lambda (x) | |
| 69 (cdr (assoc x name-to-return-type))) args ", ") | |
| 70 ");\n"))) | |
| 71 | |
| 72 (insert "\n" | |
| 73 "static void\n" | |
| 74 name " (ffi_actual_function func, GtkArg *args)\n" | |
| 75 "{\n" | |
| 76 (format " %s rfunc = (%s) func;\n" func-proto func-proto)) | |
| 77 | |
| 78 (if (string= "LIST" rval) (setq rval "POINTER")) | |
| 79 | |
| 80 (if (cdr internal-rval) | |
| 81 ;; It has a return type to worry about | |
| 82 (insert " " (cdr internal-rval) " *return_val;\n\n" | |
| 83 (format " return_val = GTK_RETLOC_%s (args[%d]);\n" rval (length args)) | |
| 84 " *return_val = ") | |
| 85 (insert " ")) | |
| 86 (insert "(*rfunc) (") | |
| 87 (while args | |
| 88 (if (/= ctr 0) | |
| 89 (insert ", ")) | |
| 90 (insert (format "GTK_VALUE_%s (args[%d])" (car args) ctr)) | |
| 91 (setq args (cdr args) | |
| 92 ctr (1+ ctr))) | |
| 93 (insert ");\n") | |
| 94 (insert "}\n"))) | |
| 95 | |
| 96 (save-excursion | |
| 591 | 97 (find-file "../src/emacs-marshals.c") |
| 462 | 98 (erase-buffer) |
| 99 (setq defined-marshallers nil) | |
| 100 | |
| 591 | 101 (insert "/* This file was automatically generated by ../lisp/gtk-marshal.el */\n" |
| 102 "/* DO NOT EDIT BY HAND!!! */\n") | |
| 462 | 103 (insert "#define GTK_VALUE_ARRAY(x) GTK_VALUE_POINTER(x)\n\n") |
| 104 (insert "#define GTK_VALUE_LIST(x) GTK_VALUE_POINTER(x)\n\n") | |
| 105 | |
| 106 (let ((todo '( | |
| 107 ("BOOL" "OBJECT" "INT") | |
| 108 ("BOOL" "OBJECT" "OBJECT" "OBJECT") | |
| 109 ("BOOL" "OBJECT" "OBJECT") | |
| 110 ("BOOL" "OBJECT" "POINTER") | |
| 111 ("BOOL" "OBJECT" "STRING") | |
| 112 ("BOOL" "OBJECT") | |
| 113 ("BOOL" "POINTER" "BOOL") | |
| 114 ("BOOL" "POINTER") | |
| 115 ("BOOL") | |
| 116 ("FLOAT" "OBJECT" "FLOAT") | |
| 117 ("FLOAT" "OBJECT") | |
| 118 ("INT" "BOOL") | |
| 119 ("INT" "OBJECT" "ARRAY") | |
| 120 ("INT" "OBJECT" "INT" "ARRAY") | |
| 121 ("INT" "OBJECT" "INT" "INT") | |
| 122 ("INT" "OBJECT" "INT" "STRING") | |
| 123 ("INT" "OBJECT" "INT") | |
| 124 ("INT" "OBJECT" "OBJECT") | |
| 125 ("INT" "OBJECT" "POINTER" "INT" "INT") | |
| 126 ("INT" "OBJECT" "POINTER" "INT") | |
| 127 ("INT" "OBJECT" "POINTER") | |
| 128 ("INT" "OBJECT" "STRING") | |
| 129 ("INT" "OBJECT") | |
| 130 ("INT" "POINTER" "INT") | |
| 131 ("INT" "POINTER" "STRING" "INT") | |
| 132 ("INT" "POINTER" "STRING" "STRING") | |
| 133 ("INT" "POINTER" "STRING") | |
| 134 ("INT" "POINTER") | |
| 135 ("INT" "STRING" "STRING" "INT" "ARRAY") | |
| 136 ("INT" "STRING") | |
| 137 ("INT") | |
| 138 ("LIST" "OBJECT") | |
| 139 ("LIST") | |
| 140 ("NONE" "BOOL") | |
| 141 ("NONE" "INT" "INT" "INT" "INT") | |
| 142 ("NONE" "INT" "INT") | |
| 143 ("NONE" "INT") | |
| 144 ("NONE" "OBJECT" "BOOL" "INT") | |
| 145 ("NONE" "OBJECT" "BOOL") | |
| 146 ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT" "BOOL") | |
| 147 ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT") | |
| 148 ("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT") | |
| 149 ("NONE" "OBJECT" "FLOAT" "FLOAT") | |
| 150 ("NONE" "OBJECT" "FLOAT") | |
| 151 ("NONE" "OBJECT" "INT" "BOOL") | |
| 152 ("NONE" "OBJECT" "INT" "FLOAT" "BOOL") | |
| 153 ("NONE" "OBJECT" "INT" "FLOAT") | |
| 154 ("NONE" "OBJECT" "INT" "INT" "ARRAY" "ARRAY" "ARRAY" "ARRAY" "ARRAY" "ARRAY") | |
| 155 ("NONE" "OBJECT" "INT" "INT" "ARRAY") | |
| 156 ("NONE" "OBJECT" "INT" "INT" "FLOAT" "FLOAT") | |
| 157 ("NONE" "OBJECT" "INT" "INT" "INT" "INT") | |
| 158 ("NONE" "OBJECT" "INT" "INT" "INT") | |
| 159 ("NONE" "OBJECT" "INT" "INT" "POINTER" "POINTER") | |
| 160 ("NONE" "OBJECT" "INT" "INT" "POINTER") | |
| 161 ("NONE" "OBJECT" "INT" "INT" "STRING" "INT" "POINTER" "POINTER") | |
| 162 ("NONE" "OBJECT" "INT" "INT" "STRING") | |
| 163 ("NONE" "OBJECT" "INT" "INT") | |
| 164 ("NONE" "OBJECT" "INT" "OBJECT") | |
| 165 ("NONE" "OBJECT" "INT" "POINTER") | |
| 166 ("NONE" "OBJECT" "INT" "STRING") | |
| 167 ("NONE" "OBJECT" "INT") | |
| 168 ("NONE" "OBJECT" "LIST" "INT") | |
| 169 ("NONE" "OBJECT" "LIST") | |
| 170 ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL" "INT" "INT") | |
| 171 ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL" "INT") | |
| 172 ("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL") | |
| 173 ("NONE" "OBJECT" "OBJECT" "FLOAT" "INT") | |
| 174 ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT" "INT" "INT" "INT" "INT" "INT") | |
| 175 ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT" "INT") | |
| 176 ("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT") | |
| 177 ("NONE" "OBJECT" "OBJECT" "INT" "INT") | |
| 178 ("NONE" "OBJECT" "OBJECT" "INT") | |
| 179 ("NONE" "OBJECT" "OBJECT" "OBJECT" "INT") | |
| 180 ("NONE" "OBJECT" "OBJECT" "OBJECT" "OBJECT" "INT") | |
| 181 ("NONE" "OBJECT" "OBJECT" "OBJECT" "OBJECT") | |
| 182 ("NONE" "OBJECT" "OBJECT" "OBJECT" "POINTER" "POINTER" "INT" "INT") | |
| 183 ("NONE" "OBJECT" "OBJECT" "OBJECT") | |
| 184 ("NONE" "OBJECT" "OBJECT" "POINTER") | |
| 185 ("NONE" "OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT" "INT") | |
| 186 ("NONE" "OBJECT" "OBJECT" "STRING" "STRING" "INT") | |
| 187 ("NONE" "OBJECT" "OBJECT" "STRING" "STRING") | |
| 188 ("NONE" "OBJECT" "OBJECT" "STRING") | |
| 189 ("NONE" "OBJECT" "OBJECT") | |
| 190 ("NONE" "OBJECT" "POINTER" "BOOL") | |
| 191 ("NONE" "OBJECT" "POINTER" "INT" "FLOAT" "FLOAT") | |
| 192 ("NONE" "OBJECT" "POINTER" "INT" "INT" "INT") | |
| 193 ("NONE" "OBJECT" "POINTER" "INT" "INT") | |
| 194 ("NONE" "OBJECT" "POINTER" "INT" "POINTER" "POINTER") | |
| 195 ("NONE" "OBJECT" "POINTER" "INT" "POINTER") | |
| 196 ("NONE" "OBJECT" "POINTER" "INT" "STRING" "INT" "POINTER" "POINTER") | |
| 197 ("NONE" "OBJECT" "POINTER" "INT" "STRING") | |
| 198 ("NONE" "OBJECT" "POINTER" "INT") | |
| 199 ("NONE" "OBJECT" "POINTER" "POINTER" "INT" "INT" "INT" "INT" "INT" "INT") | |
| 200 ("NONE" "OBJECT" "POINTER" "POINTER" "POINTER" "STRING" "INT") | |
| 201 ("NONE" "OBJECT" "POINTER" "POINTER" "POINTER") | |
| 202 ("NONE" "OBJECT" "POINTER" "POINTER") | |
| 203 ("NONE" "OBJECT" "POINTER" "STRING" "INT" "POINTER" "POINTER" "POINTER" "POINTER" "BOOL" "BOOL") | |
| 204 ("NONE" "OBJECT" "POINTER") | |
| 205 ("NONE" "OBJECT" "STRING" "BOOL") | |
| 206 ("NONE" "OBJECT" "STRING" "INT" "INT" "INT") | |
| 207 ("NONE" "OBJECT" "STRING" "POINTER" "INT" "INT" "INT") | |
| 208 ("NONE" "OBJECT" "STRING" "POINTER" "INT" "INT") | |
| 209 ("NONE" "OBJECT" "STRING" "STRING") | |
| 210 ("NONE" "OBJECT" "STRING") | |
| 211 ("NONE" "OBJECT") | |
| 833 | 212 ("NONE" "POINTER" "INT" "INT") |
| 462 | 213 ("NONE" "POINTER" "INT") |
| 214 ("NONE" "POINTER" "POINTER" "BOOL" "INT" "INT" "INT" "INT" "INT" "INT") | |
| 215 ("NONE" "POINTER" "POINTER" "BOOL" "INT" "INT" "INT" "INT") | |
| 216 ("NONE" "POINTER" "POINTER" "INT" "INT" "INT" "INT") | |
| 217 ("NONE" "POINTER" "POINTER" "INT" "INT") | |
| 218 ("NONE" "POINTER" "POINTER" "POINTER" "INT" "INT" "STRING" "INT") | |
| 219 ("NONE" "POINTER" "POINTER" "POINTER" "INT" "INT" "STRING") | |
| 220 ("NONE" "POINTER" "POINTER" "POINTER" "POINTER") | |
| 221 ("NONE" "POINTER" "POINTER") | |
| 222 ("NONE" "POINTER" "STRING" "STRING") | |
| 223 ("NONE" "POINTER" "STRING") | |
| 224 ("NONE" "POINTER") | |
| 225 ("NONE") | |
| 226 ("OBJECT" "BOOL" "BOOL" "INT") | |
| 227 ("OBJECT" "BOOL" "INT") | |
| 228 ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT") | |
| 229 ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT") | |
| 230 ("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT") | |
| 231 ("OBJECT" "INT" "ARRAY") | |
| 232 ("OBJECT" "INT" "BOOL" "BOOL") | |
| 233 ("OBJECT" "INT" "INT" "ARRAY") | |
| 234 ("OBJECT" "INT" "INT" "BOOL") | |
| 235 ("OBJECT" "INT" "INT" "STRING") | |
| 236 ("OBJECT" "INT" "INT") | |
| 237 ("OBJECT" "INT") | |
| 238 ("OBJECT" "OBJECT" "FLOAT" "INT") | |
| 239 ("OBJECT" "OBJECT" "INT") | |
| 240 ("OBJECT" "OBJECT" "OBJECT") | |
| 241 ("OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT" "INT") | |
| 242 ("OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT") | |
| 243 ("OBJECT" "OBJECT" "STRING" "INT" "INT") | |
| 244 ("OBJECT" "OBJECT" "STRING") | |
| 245 ("OBJECT" "OBJECT") | |
| 246 ("OBJECT" "POINTER" "POINTER") | |
| 247 ("OBJECT" "POINTER" "STRING") | |
| 248 ("OBJECT" "POINTER") | |
| 249 ("OBJECT" "STRING" "FLOAT" "FLOAT" "FLOAT" "BOOL") | |
| 250 ("OBJECT" "STRING" "INT" "STRING" "STRING") | |
| 251 ("OBJECT" "STRING" "OBJECT") | |
| 252 ("OBJECT" "STRING" "STRING" "STRING" "ARRAY" "STRING" "STRING") | |
| 253 ("OBJECT" "STRING" "STRING") | |
| 254 ("OBJECT" "STRING") | |
| 255 ("OBJECT") | |
| 256 ("POINTER" "INT" "INT") | |
| 257 ("POINTER" "INT") | |
| 258 ("POINTER" "OBJECT" "INT" "INT") | |
| 259 ("POINTER" "OBJECT" "INT") | |
| 260 ("POINTER" "OBJECT" "POINTER" "INT") | |
| 261 ("POINTER" "OBJECT" "POINTER" "POINTER" "ARRAY" "INT" "POINTER" "POINTER" "POINTER" "POINTER" "BOOL" "BOOL") | |
| 262 ("POINTER" "OBJECT" "POINTER") | |
| 263 ("POINTER" "OBJECT") | |
| 264 ("POINTER" "POINTER") | |
| 833 | 265 ("POINTER" "STRING" "INT") |
| 462 | 266 ("POINTER") |
| 267 ("STRING" "INT" "INT" "INT") | |
| 268 ("STRING" "INT") | |
| 269 ("STRING" "OBJECT" "BOOL") | |
| 270 ("STRING" "OBJECT" "FLOAT") | |
| 271 ("STRING" "OBJECT" "INT" "INT") | |
| 272 ("STRING" "OBJECT" "INT") | |
| 273 ("STRING" "OBJECT") | |
| 274 ("STRING" "POINTER" "STRING") | |
| 275 ("STRING" "POINTER") | |
| 276 ("STRING") | |
| 277 ) | |
| 278 ) | |
| 279 ) | |
| 280 (mapc (lambda (x) (apply 'define-marshaller x)) todo) | |
| 281 | |
| 282 (insert "\n | |
| 283 #include \"hash.h\" | |
| 608 | 284 |
| 285 static struct hash_table *marshaller_hashtable; | |
| 462 | 286 |
| 287 static void initialize_marshaller_storage (void) | |
| 288 { | |
| 289 if (!marshaller_hashtable) | |
| 290 { | |
| 2523 | 291 marshaller_hashtable = make_string_hash_table (100); |
| 462 | 292 ") |
| 293 | |
| 294 (mapc (lambda (x) | |
| 295 (let ((name (get-marshaller-name (car x) (cdr x)))) | |
| 296 (insert (format "\t\tputhash (\"%s\", (void *) %s, marshaller_hashtable);\n" name name)))) | |
| 297 todo) | |
| 298 (insert "\t};\n" | |
| 299 "}\n" | |
| 300 " | |
| 301 static void *find_marshaller (const char *func_name) | |
| 302 { | |
| 303 void *fn = NULL; | |
| 304 initialize_marshaller_storage (); | |
| 305 | |
| 591 | 306 if (gethash (func_name, marshaller_hashtable, (const void **)&fn)) |
| 462 | 307 { |
| 308 return (fn); | |
| 309 } | |
| 310 | |
| 311 return (NULL); | |
| 312 } | |
| 313 ")) | |
| 314 | |
| 315 (save-buffer) | |
| 316 (kill-buffer "emacs-marshals.c")) |