[clg] / glib / genums.lisp

;; Common Lisp bindings for GTK+ v2.0
;; Copyright (C) 2000-2001 Espen S. Johnsen <esj@stud.cs.uit.no>
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 2 of the License, or (at your option) any later version.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

;; $Id: genums.lisp,v 1.9 2005-02-11 19:09:38 espen Exp $

(in-package "GLIB")
  
;;;; Generic enum type

(defun %map-enum (mappings op)
  (loop
   as value = 1 then (1+ value)
   for mapping in mappings
   collect (let ((symbol (if (atom mapping) mapping (first mapping))))
	     (unless (atom mapping)
	       (setq value (second mapping)))
	     (ecase op
	       (:symbol-int (list symbol value))
	       (:int-symbol (list value symbol))
	       (:symbols symbol)))))

(deftype enum (&rest args)
  `(member ,@(%map-enum args :symbols)))

(defmethod alien-type ((type (eql 'enum)) &rest args)
  (declare (ignore type args))
  (alien-type 'signed))

(defmethod size-of ((type (eql 'enum)) &rest args)
  (declare (ignore type args))
  (size-of 'signed))

(defmethod to-alien-form (form (type (eql 'enum)) &rest args)
  (declare (ignore type))
  `(case ,form
    ,@(%map-enum args :symbol-int)
    (t (error 'type-error :datum ,form :expected-type '(enum ,@args)))))


(defmethod from-alien-form (form (type (eql 'enum)) &rest args)
  (declare (ignore type))
  `(ecase ,form
    ,@(%map-enum args :int-symbol)))

(defmethod to-alien-function ((type (eql 'enum)) &rest args)
  (declare (ignore type))
  (let ((mappings (%map-enum args :symbol-int)))
    #'(lambda (enum)
	(or
	 (second (assoc enum mappings))
	 (error 'type-error :datum enum :expected-type (cons 'enum args))))))

(defmethod from-alien-function ((type (eql 'enum)) &rest args)
  (declare (ignore type))
  (let ((mappings (%map-enum args :int-symbol)))
    #'(lambda (int)
	(second (assoc int mappings)))))

(defmethod writer-function ((type (eql 'enum)) &rest args)
  (declare (ignore type))
  (let ((writer (writer-function 'signed))
	(function (apply #'to-alien-function 'enum args)))
    #'(lambda (enum location &optional (offset 0))
	(funcall writer (funcall function enum) location offset))))
    
(defmethod reader-function ((type (eql 'enum)) &rest args)
  (declare (ignore type))
  (let ((reader (reader-function 'signed))
	(function (apply #'from-alien-function 'enum args)))
    #'(lambda (location &optional (offset 0))
	(funcall function (funcall reader location offset)))))

(defun enum-int (enum type)
  (funcall (to-alien-function type) enum))

(defun int-enum (int type)
  (funcall (from-alien-function type) int))

(defun enum-mapping (type)
  (rest (type-expand-to 'enum type)))


;;;; Named enum types

(defmacro define-enum-type (name &rest args)
  (let ((enum-int (intern (format nil "~A-TO-INT" name)))
	(int-enum (intern (format nil "INT-TO-~A" name))))
    `(progn
       (deftype ,name () '(enum ,@args))
       (defun ,enum-int (enum)
	 (case enum
	   ,@(%map-enum args :symbol-int)
	   (t (error 'type-error :datum enum :expected-type ',name))))
       (defun ,int-enum (value)
	 (ecase value
	   ,@(%map-enum args :int-symbol)))
       (defmethod to-alien-form (form (type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 (list ',enum-int form))
       (defmethod from-alien-form (form (type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 (list ',int-enum form))
       (defmethod to-alien-function ((type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 #',enum-int)
       (defmethod from-alien-function ((type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 #',int-enum)
       (defmethod writer-function ((type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 (let ((writer (writer-function 'signed)))
	   #'(lambda (enum location &optional (offset 0))
	       (funcall writer (,enum-int enum) location offset))))    
       (defmethod reader-function ((type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 (let ((reader (reader-function 'signed)))
	   #'(lambda (location &optional (offset 0))
	       (,int-enum (funcall reader location offset))))))))


;;;;  Generic flags type

(defun %map-flags (mappings op)
  (loop
   as value = 1 then (ash value 1)
   for mapping in mappings
   collect (let ((symbol (if (atom mapping) mapping (first mapping))))
	     (unless (atom mapping)
	       (setq value (second mapping)))
	     (ecase op
	       (:symbol-int (list symbol value))
	       (:int-symbol (list value symbol))
	       (:symbols symbol)))))

(deftype flags (&rest args)
  `(or (member ,@(%map-flags args :symbols)) list))

(defmethod alien-type ((type (eql 'flags)) &rest args)
  (declare (ignore type args))
  (alien-type 'unsigned))

(defmethod size-of ((type (eql 'flags)) &rest args)
  (declare (ignore type args))
  (size-of 'unsigned))

(defmethod to-alien-form (flags (type (eql 'flags)) &rest args)
  `(reduce #'logior (mklist ,flags)
    :key #'(lambda (flag)
	     (case flag
	       ,@(%map-flags args :symbol-int)
	       (t (error 'type-error :datum ,flags 
		   :expected-type '(,type ,@args)))))))

(defmethod from-alien-form (int (type (eql 'flags)) &rest args)
  (declare (ignore type))
  `(loop
    for mapping in ',(%map-flags args :int-symbol)
    unless (zerop (logand ,int (first mapping)))
    collect (second mapping)))

(defmethod to-alien-function ((type (eql 'flags)) &rest args)
  (declare (ignore type))
  (let ((mappings (%map-flags args :symbol-int)))
    #'(lambda (flags)
	(reduce #'logior (mklist flags)
	 :key #'(lambda (flag)
		  (or
		   (second (assoc flag mappings))
		   (error 'type-error :datum flags 
		    :expected-type (cons 'flags args))))))))

(defmethod from-alien-function ((type (eql 'flags)) &rest args)
  (declare (ignore type))
  (let ((mappings (%map-flags args :int-symbol)))
    #'(lambda (int)
	(loop
	 for mapping in mappings
	 unless (zerop (logand int (first mapping)))
	 collect (second mapping)))))

(defmethod writer-function ((type (eql 'flags)) &rest args)
  (declare (ignore type))
  (let ((writer (writer-function 'unsigned))
	(function (apply #'to-alien-function 'flags args)))
    #'(lambda (flags location &optional (offset 0))
	(funcall writer (funcall function flags) location offset))))
    
(defmethod reader-function ((type (eql 'flags)) &rest args)
  (declare (ignore type))
  (let ((reader (reader-function 'unsigned))
	(function (apply #'from-alien-function 'flags args)))
    #'(lambda (location &optional (offset 0))
	(funcall function (funcall reader location offset)))))


;;;; Named flags types

(defmacro define-flags-type (name &rest args)
  (let ((flags-int (intern (format nil "~A-TO-INT" name)))
	(int-flags (intern (format nil "INT-TO-~A" name)))
	(satisfies  (intern (format nil "~A-P" name))))
    `(progn
       (deftype ,name () '(satisfies ,satisfies))
       (defun ,satisfies (object)
	 (flet ((valid-p (ob)
		  (find ob ',(%map-flags args :symbols))))
	   (typecase object
	     (symbol (valid-p object))
	     (list (every #'valid-p object)))))
       (defun ,flags-int (flags)
	 (reduce #'logior (mklist flags)
	  :key #'(lambda (flag)
		   (case flag
		     ,@(%map-flags args :symbol-int)
		     (t (error 'type-error :datum flags 
		         :expected-type ',name))))))
       (defun ,int-flags (value)
	 (loop
	  for mapping in ',(%map-flags args :int-symbol)
	  unless (zerop (logand value (first mapping)))
	  collect (second mapping)))
       (defmethod alien-type ((type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 (alien-type 'flags))
       (defmethod size-of ((type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 (size-of 'flags))
       (defmethod to-alien-form (form (type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 (list ',flags-int form))
       (defmethod from-alien-form (form (type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 (list ',int-flags form))
       (defmethod to-alien-function ((type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 #',flags-int)
       (defmethod from-alien-function ((type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 #',int-flags)
       (defmethod writer-function ((type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 (let ((writer (writer-function 'signed)))
	   #'(lambda (flags location &optional (offset 0))
	       (funcall writer (,flags-int flags) location offset))))    
       (defmethod reader-function ((type (eql ',name)) &rest args)
	 (declare (ignore type args))
	 (let ((reader (reader-function 'signed)))
	   #'(lambda (location &optional (offset 0))
	       (,int-flags (funcall reader location offset))))))))


;;;; Type definition by introspection

(defun %query-enum-or-flags-values (query-function class type)
  (multiple-value-bind (sap length)
      (funcall query-function (type-class-ref type))
    (let ((values nil)
	  (size (proxy-instance-size (find-class class)))
	  (proxy (make-instance class :location sap)))
      (dotimes (i length)
	(with-slots (location nickname value) proxy
	  (setf location sap)
	  (setq sap (sap+ sap size))
	  (push
	   (list
	    (intern (substitute #\- #\_ (string-upcase nickname)) "KEYWORD")
	    value)
	   values)))
      values)))


(defclass %enum-value (struct)
  ((value :allocation :alien :type int)
   (name :allocation :alien :type string)
   (nickname :allocation :alien :type string))
  (:metaclass static-struct-class))

(defbinding %enum-class-values () pointer
  (class pointer)
  (n-values unsigned-int :out))

(defun query-enum-values (type)
  (%query-enum-or-flags-values #'%enum-class-values '%enum-value type))


(defclass %flags-value (struct)
  ((value :allocation :alien :type unsigned-int)
   (name :allocation :alien :type string)
   (nickname :allocation :alien :type string))
  (:metaclass static-struct-class))

(defbinding %flags-class-values () pointer
  (class pointer)
  (n-values unsigned-int :out))

(defun query-flags-values (type)
  (%query-enum-or-flags-values #'%flags-class-values '%flags-value type))


(defun expand-enum-type (type-number forward-p options)
  (declare (ignore forward-p))
  (let* ((super (supertype type-number))
	 (type (type-from-number type-number))
	 (mappings (getf options :mappings))
	 (expanded-mappings
	  (append
	   (delete-if
	    #'(lambda (mapping)
		(or
		 (assoc (first mapping) mappings)
		 (rassoc (cdr mapping) mappings :test #'equal)))
	    (if (eq super 'enum)
		(query-enum-values type-number)
	      (query-flags-values type-number)))
	   (remove-if
	    #'(lambda (mapping) (eq (second mapping) nil)) mappings))))
    `(progn
       (register-type ',type ,(find-type-name type-number))
       ,(ecase super
	  (enum `(define-enum-type ,type ,@expanded-mappings))
	  (flags `(define-flags-type ,type ,@expanded-mappings))))))


(register-derivable-type 'enum "GEnum" 'expand-enum-type)
(register-derivable-type 'flags "GFlags" 'expand-enum-type)
Commit	Line	Data
94f15c3c	1	;; Common Lisp bindings for GTK+ v2.0
	2	;; Copyright (C) 2000-2001 Espen S. Johnsen <esj@stud.cs.uit.no>
	3	;;
	4	;; This library is free software; you can redistribute it and/or
	5	;; modify it under the terms of the GNU Lesser General Public
	6	;; License as published by the Free Software Foundation; either
	7	;; version 2 of the License, or (at your option) any later version.
	8	;;
	9	;; This library is distributed in the hope that it will be useful,
	10	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	11	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	12	;; Lesser General Public License for more details.
	13	;;
	14	;; You should have received a copy of the GNU Lesser General Public
	15	;; License along with this library; if not, write to the Free Software
	16	;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	17
33939600	18	;; $Id: genums.lisp,v 1.9 2005-02-11 19:09:38 espen Exp $
94f15c3c	19
94f15c3c	20	(in-package "GLIB")
d4b21b08	21
9adccb27	22	;;;; Generic enum type
94f15c3c	23
33939600	24	(defun %map-enum (mappings op)
	25	(loop
	26	as value = 1 then (1+ value)
	27	for mapping in mappings
	28	collect (let ((symbol (if (atom mapping) mapping (first mapping))))
	29	(unless (atom mapping)
	30	(setq value (second mapping)))
	31	(ecase op
	32	(:symbol-int (list symbol value))
	33	(:int-symbol (list value symbol))
	34	(:symbols symbol)))))
	35
94f15c3c	36	(deftype enum (&rest args)
9adccb27	37	`(member ,@(%map-enum args :symbols)))
	38
	39	(defmethod alien-type ((type (eql 'enum)) &rest args)
	40	(declare (ignore type args))
	41	(alien-type 'signed))
	42
	43	(defmethod size-of ((type (eql 'enum)) &rest args)
	44	(declare (ignore type args))
	45	(size-of 'signed))
	46
	47	(defmethod to-alien-form (form (type (eql 'enum)) &rest args)
	48	(declare (ignore type))
33939600	49	`(case ,form
	50	,@(%map-enum args :symbol-int)
	51	(t (error 'type-error :datum ,form :expected-type '(enum ,@args)))))
	52
9adccb27	53
	54	(defmethod from-alien-form (form (type (eql 'enum)) &rest args)
	55	(declare (ignore type))
	56	`(ecase ,form
33939600	57	,@(%map-enum args :int-symbol)))
9adccb27	58
9adccb27	59	(defmethod to-alien-function ((type (eql 'enum)) &rest args)
33939600	60	(declare (ignore type))
33939600	61	(let ((mappings (%map-enum args :symbol-int)))
9adccb27	62	#'(lambda (enum)
	63	(or
	64	(second (assoc enum mappings))
33939600	65	(error 'type-error :datum enum :expected-type (cons 'enum args))))))
9adccb27	66
	67	(defmethod from-alien-function ((type (eql 'enum)) &rest args)
	68	(declare (ignore type))
33939600	69	(let ((mappings (%map-enum args :int-symbol)))
9adccb27	70	#'(lambda (int)
	71	(second (assoc int mappings)))))
	72
	73	(defmethod writer-function ((type (eql 'enum)) &rest args)
	74	(declare (ignore type))
	75	(let ((writer (writer-function 'signed))
	76	(function (apply #'to-alien-function 'enum args)))
	77	#'(lambda (enum location &optional (offset 0))
	78	(funcall writer (funcall function enum) location offset))))
	79
	80	(defmethod reader-function ((type (eql 'enum)) &rest args)
	81	(declare (ignore type))
	82	(let ((reader (reader-function 'signed))
	83	(function (apply #'from-alien-function 'enum args)))
	84	#'(lambda (location &optional (offset 0))
	85	(funcall function (funcall reader location offset)))))
	86
487aa284	87	(defun enum-int (enum type)
487aa284	88	(funcall (to-alien-function type) enum))
94f15c3c	89
487aa284	90	(defun int-enum (int type)
	91	(funcall (from-alien-function type) int))
	92
	93	(defun enum-mapping (type)
	94	(rest (type-expand-to 'enum type)))
94f15c3c	95
bdd137d2	96
	97	;;;; Named enum types
	98
	99	(defmacro define-enum-type (name &rest args)
	100	(let ((enum-int (intern (format nil "~A-TO-INT" name)))
	101	(int-enum (intern (format nil "INT-TO-~A" name))))
	102	`(progn
	103	(deftype ,name () '(enum ,@args))
33939600	104	(defun ,enum-int (enum)
	105	(case enum
	106	,@(%map-enum args :symbol-int)
	107	(t (error 'type-error :datum enum :expected-type ',name))))
bdd137d2	108	(defun ,int-enum (value)
bdd137d2	109	(ecase value
33939600	110	,@(%map-enum args :int-symbol)))
bdd137d2	111	(defmethod to-alien-form (form (type (eql ',name)) &rest args)
	112	(declare (ignore type args))
	113	(list ',enum-int form))
	114	(defmethod from-alien-form (form (type (eql ',name)) &rest args)
	115	(declare (ignore type args))
	116	(list ',int-enum form))
	117	(defmethod to-alien-function ((type (eql ',name)) &rest args)
	118	(declare (ignore type args))
	119	#',enum-int)
	120	(defmethod from-alien-function ((type (eql ',name)) &rest args)
	121	(declare (ignore type args))
	122	#',int-enum)
	123	(defmethod writer-function ((type (eql ',name)) &rest args)
	124	(declare (ignore type args))
	125	(let ((writer (writer-function 'signed)))
	126	#'(lambda (enum location &optional (offset 0))
	127	(funcall writer (,enum-int enum) location offset))))
	128	(defmethod reader-function ((type (eql ',name)) &rest args)
	129	(declare (ignore type args))
	130	(let ((reader (reader-function 'signed)))
	131	#'(lambda (location &optional (offset 0))
	132	(,int-enum (funcall reader location offset))))))))
	133
	134
9adccb27	135	;;;; Generic flags type
94f15c3c	136
33939600	137	(defun %map-flags (mappings op)
	138	(loop
	139	as value = 1 then (ash value 1)
	140	for mapping in mappings
	141	collect (let ((symbol (if (atom mapping) mapping (first mapping))))
	142	(unless (atom mapping)
	143	(setq value (second mapping)))
	144	(ecase op
	145	(:symbol-int (list symbol value))
	146	(:int-symbol (list value symbol))
	147	(:symbols symbol)))))
	148
94f15c3c	149	(deftype flags (&rest args)
33939600	150	`(or (member ,@(%map-flags args :symbols)) list))
9adccb27	151
	152	(defmethod alien-type ((type (eql 'flags)) &rest args)
	153	(declare (ignore type args))
	154	(alien-type 'unsigned))
	155
	156	(defmethod size-of ((type (eql 'flags)) &rest args)
	157	(declare (ignore type args))
	158	(size-of 'unsigned))
	159
	160	(defmethod to-alien-form (flags (type (eql 'flags)) &rest args)
33939600	161	`(reduce #'logior (mklist ,flags)
	162	:key #'(lambda (flag)
	163	(case flag
	164	,@(%map-flags args :symbol-int)
	165	(t (error 'type-error :datum ,flags
	166	:expected-type '(,type ,@args)))))))
9adccb27	167
	168	(defmethod from-alien-form (int (type (eql 'flags)) &rest args)
	169	(declare (ignore type))
	170	`(loop
33939600	171	for mapping in ',(%map-flags args :int-symbol)
466cf192	172	unless (zerop (logand ,int (first mapping)))
9adccb27	173	collect (second mapping)))
	174
	175	(defmethod to-alien-function ((type (eql 'flags)) &rest args)
33939600	176	(declare (ignore type))
	177	(let ((mappings (%map-flags args :symbol-int)))
	178	#'(lambda (flags)
	179	(reduce #'logior (mklist flags)
	180	:key #'(lambda (flag)
	181	(or
	182	(second (assoc flag mappings))
	183	(error 'type-error :datum flags
	184	:expected-type (cons 'flags args))))))))
9adccb27	185
	186	(defmethod from-alien-function ((type (eql 'flags)) &rest args)
	187	(declare (ignore type))
33939600	188	(let ((mappings (%map-flags args :int-symbol)))
9adccb27	189	#'(lambda (int)
	190	(loop
	191	for mapping in mappings
	192	unless (zerop (logand int (first mapping)))
	193	collect (second mapping)))))
	194
	195	(defmethod writer-function ((type (eql 'flags)) &rest args)
	196	(declare (ignore type))
	197	(let ((writer (writer-function 'unsigned))
	198	(function (apply #'to-alien-function 'flags args)))
	199	#'(lambda (flags location &optional (offset 0))
	200	(funcall writer (funcall function flags) location offset))))
	201
	202	(defmethod reader-function ((type (eql 'flags)) &rest args)
	203	(declare (ignore type))
	204	(let ((reader (reader-function 'unsigned))
	205	(function (apply #'from-alien-function 'flags args)))
	206	#'(lambda (location &optional (offset 0))
	207	(funcall function (funcall reader location offset)))))
	208
	209
bdd137d2	210	;;;; Named flags types
d4b21b08	211
bdd137d2	212	(defmacro define-flags-type (name &rest args)
bdd137d2	213	(let ((flags-int (intern (format nil "~A-TO-INT" name)))
33939600	214	(int-flags (intern (format nil "INT-TO-~A" name)))
33939600	215	(satisfies (intern (format nil "~A-P" name))))
bdd137d2	216	`(progn
33939600	217	(deftype ,name () '(satisfies ,satisfies))
	218	(defun ,satisfies (object)
	219	(flet ((valid-p (ob)
	220	(find ob ',(%map-flags args :symbols))))
	221	(typecase object
	222	(symbol (valid-p object))
	223	(list (every #'valid-p object)))))
	224	(defun ,flags-int (flags)
	225	(reduce #'logior (mklist flags)
	226	:key #'(lambda (flag)
	227	(case flag
	228	,@(%map-flags args :symbol-int)
	229	(t (error 'type-error :datum flags
	230	:expected-type ',name))))))
bdd137d2	231	(defun ,int-flags (value)
33939600	232	(loop
	233	for mapping in ',(%map-flags args :int-symbol)
	234	unless (zerop (logand value (first mapping)))
	235	collect (second mapping)))
	236	(defmethod alien-type ((type (eql ',name)) &rest args)
	237	(declare (ignore type args))
	238	(alien-type 'flags))
	239	(defmethod size-of ((type (eql ',name)) &rest args)
	240	(declare (ignore type args))
	241	(size-of 'flags))
bdd137d2	242	(defmethod to-alien-form (form (type (eql ',name)) &rest args)
	243	(declare (ignore type args))
	244	(list ',flags-int form))
	245	(defmethod from-alien-form (form (type (eql ',name)) &rest args)
	246	(declare (ignore type args))
	247	(list ',int-flags form))
	248	(defmethod to-alien-function ((type (eql ',name)) &rest args)
	249	(declare (ignore type args))
	250	#',flags-int)
	251	(defmethod from-alien-function ((type (eql ',name)) &rest args)
	252	(declare (ignore type args))
	253	#',int-flags)
	254	(defmethod writer-function ((type (eql ',name)) &rest args)
	255	(declare (ignore type args))
	256	(let ((writer (writer-function 'signed)))
	257	#'(lambda (flags location &optional (offset 0))
	258	(funcall writer (,flags-int flags) location offset))))
	259	(defmethod reader-function ((type (eql ',name)) &rest args)
	260	(declare (ignore type args))
	261	(let ((reader (reader-function 'signed)))
	262	#'(lambda (location &optional (offset 0))
	263	(,int-flags (funcall reader location offset))))))))
	264
	265
	266
	267	;;;; Type definition by introspection
d4b21b08	268
33939600	269	(defun %query-enum-or-flags-values (query-function class type)
	270	(multiple-value-bind (sap length)
	271	(funcall query-function (type-class-ref type))
	272	(let ((values nil)
	273	(size (proxy-instance-size (find-class class)))
	274	(proxy (make-instance class :location sap)))
	275	(dotimes (i length)
	276	(with-slots (location nickname value) proxy
	277	(setf location sap)
	278	(setq sap (sap+ sap size))
	279	(push
	280	(list
	281	(intern (substitute #\- #\_ (string-upcase nickname)) "KEYWORD")
	282	value)
	283	values)))
	284	values)))
	285
	286
	287	(defclass %enum-value (struct)
	288	((value :allocation :alien :type int)
	289	(name :allocation :alien :type string)
	290	(nickname :allocation :alien :type string))
	291	(:metaclass static-struct-class))
	292
	293	(defbinding %enum-class-values () pointer
	294	(class pointer)
	295	(n-values unsigned-int :out))
	296
	297	(defun query-enum-values (type)
	298	(%query-enum-or-flags-values #'%enum-class-values '%enum-value type))
	299
	300
	301	(defclass %flags-value (struct)
	302	((value :allocation :alien :type unsigned-int)
	303	(name :allocation :alien :type string)
	304	(nickname :allocation :alien :type string))
	305	(:metaclass static-struct-class))
	306
	307	(defbinding %flags-class-values () pointer
	308	(class pointer)
	309	(n-values unsigned-int :out))
	310
	311	(defun query-flags-values (type)
	312	(%query-enum-or-flags-values #'%flags-class-values '%flags-value type))
	313
	314
62f12808	315	(defun expand-enum-type (type-number forward-p options)
466cf192	316	(declare (ignore forward-p))
d4b21b08	317	(let* ((super (supertype type-number))
d4b21b08	318	(type (type-from-number type-number))
b0bb0027	319	(mappings (getf options :mappings))
d4b21b08	320	(expanded-mappings
	321	(append
	322	(delete-if
	323	#'(lambda (mapping)
	324	(or
	325	(assoc (first mapping) mappings)
	326	(rassoc (cdr mapping) mappings :test #'equal)))
	327	(if (eq super 'enum)
	328	(query-enum-values type-number)
	329	(query-flags-values type-number)))
	330	(remove-if
	331	#'(lambda (mapping) (eq (second mapping) nil)) mappings))))
	332	`(progn
	333	(register-type ',type ,(find-type-name type-number))
bdd137d2	334	,(ecase super
	335	(enum `(define-enum-type ,type ,@expanded-mappings))
	336	(flags `(define-flags-type ,type ,@expanded-mappings))))))
d4b21b08	337
d4b21b08	338
b0bb0027	339	(register-derivable-type 'enum "GEnum" 'expand-enum-type)
b0bb0027	340	(register-derivable-type 'flags "GFlags" 'expand-enum-type)
94f15c3c	341