| 1 | /* Define a C preprocessor symbol that can be used in interface files |
| 2 | to distinguish between the SWIG language modules. */ |
| 3 | |
| 4 | #define SWIG_ALLEGRO_CL |
| 5 | |
| 6 | /* Typespecs for basic types. */ |
| 7 | |
| 8 | %typemap(ffitype) char ":char"; |
| 9 | %typemap(lisptype) char "character"; |
| 10 | %typemap(ffitype) unsigned char ":unsigned-char"; |
| 11 | %typemap(lisptype) unsigned char "integer"; |
| 12 | %typemap(ffitype) signed char ":char"; |
| 13 | %typemap(lisptype) signed char "integer"; |
| 14 | %typemap(ffitype) short ":short"; |
| 15 | %typemap(ffitype) signed short ":short"; |
| 16 | %typemap(ffitype) unsigned short ":unsigned-short"; |
| 17 | %typemap(ffitype) int ":int"; |
| 18 | %typemap(ffitype) signed int ":int"; |
| 19 | %typemap(ffitype) unsigned int ":unsigned-int"; |
| 20 | %typemap(ffitype) long ":long"; |
| 21 | %typemap(ffitype) signed long ":long"; |
| 22 | %typemap(ffitype) unsigned long ":unsigned-long"; |
| 23 | %typemap(ffitype) float ":float"; |
| 24 | %typemap(ffitype) double ":double"; |
| 25 | %typemap(ffitype) char * "(* :char)"; |
| 26 | %typemap(ffitype) void * "(* :void)"; |
| 27 | %typemap(ffitype) void ":void"; |
| 28 | |
| 29 | %wrapper %{ |
| 30 | ;; $Id: allegrocl.swg,v 1.6 2004/08/23 15:28:58 mkoeppe Exp $ |
| 31 | |
| 32 | (eval-when (compile eval) |
| 33 | |
| 34 | ;;; You can define your own identifier converter if you want. |
| 35 | ;;; Use the -identifier-converter command line argument to |
| 36 | ;;; specify its name. |
| 37 | |
| 38 | (defun identifier-convert-null (id &key type) |
| 39 | (declare (ignore type)) |
| 40 | (read-from-string id)) |
| 41 | |
| 42 | (defun identifier-convert-lispify (cname &key type) |
| 43 | (assert (stringp cname)) |
| 44 | (if (eq type :constant) |
| 45 | (setf cname (format nil "*~A*" cname))) |
| 46 | (setf cname (replace-regexp cname "_" "-")) |
| 47 | (let ((lastcase :other) |
| 48 | newcase char res) |
| 49 | (dotimes (n (length cname)) |
| 50 | (setf char (schar cname n)) |
| 51 | (if* (alpha-char-p char) |
| 52 | then |
| 53 | (setf newcase (if (upper-case-p char) :upper :lower)) |
| 54 | |
| 55 | (when (or (and (eq lastcase :upper) (eq newcase :lower)) |
| 56 | (and (eq lastcase :lower) (eq newcase :upper))) |
| 57 | ;; case change... add a dash |
| 58 | (push #\- res) |
| 59 | (setf newcase :other)) |
| 60 | |
| 61 | (push (char-downcase char) res) |
| 62 | |
| 63 | (setf lastcase newcase) |
| 64 | |
| 65 | else |
| 66 | (push char res) |
| 67 | (setf lastcase :other))) |
| 68 | (read-from-string (coerce (nreverse res) 'string)))) |
| 69 | |
| 70 | (defmacro swig-defconstant (string value) |
| 71 | (let ((symbol (funcall *swig-identifier-converter* string :type :constant))) |
| 72 | `(eval-when (compile load eval) |
| 73 | (defconstant ,symbol ,value) |
| 74 | (export (quote ,symbol))))) |
| 75 | |
| 76 | (defmacro swig-defun (name &rest rest) |
| 77 | (let ((symbol (funcall *swig-identifier-converter* name :type :operator))) |
| 78 | `(eval-when (compile load eval) |
| 79 | (excl::compiler-let ((*record-xref-info* nil)) |
| 80 | (ff:def-foreign-call (,symbol ,name) ,@rest) |
| 81 | (export (quote ,symbol)))))) |
| 82 | |
| 83 | (defmacro swig-def-foreign-type (name &rest rest) |
| 84 | (let ((symbol (funcall *swig-identifier-converter* name :type :type))) |
| 85 | `(eval-when (compile load eval) |
| 86 | (ff:def-foreign-type ,symbol ,@rest) |
| 87 | (export (quote ,symbol))))) |
| 88 | |
| 89 | ) ;; eval-when |
| 90 | %} |