chiark
/
gitweb
/
~mdw
/
clg
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fixed a few bugs regarding pointer and keyboard grabbing
[clg]
/
glib
/
genums.lisp
diff --git
a/glib/genums.lisp
b/glib/genums.lisp
index 1ed19c2be424c6ea961204f77d12160a89296208..06985c697e6769de2950861bf4eef82feea64857 100644
(file)
--- a/
glib/genums.lisp
+++ b/
glib/genums.lisp
@@
-15,7
+15,7
@@
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;; 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 $
+;; $Id: genums.lisp,v 1.
12 2005-03-06 17:26:23
espen Exp $
(in-package "GLIB")
(in-package "GLIB")
@@
-23,14
+23,15
@@
(in-package "GLIB")
(defun %map-enum (mappings op)
(loop
(defun %map-enum (mappings op)
(loop
- as value =
1
then (1+ value)
+ as value =
0
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
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))
+ (:symbol-int `(,symbol ,value))
+ (:int-symbol `(,value ,symbol))
+ (:int-quoted-symbol `(,value ',symbol))
(:symbols symbol)))))
(deftype enum (&rest args)
(:symbols symbol)))))
(deftype enum (&rest args)
@@
-53,8
+54,8
@@
(defmethod to-alien-form (form (type (eql 'enum)) &rest args)
(defmethod from-alien-form (form (type (eql 'enum)) &rest args)
(declare (ignore type))
(defmethod from-alien-form (form (type (eql 'enum)) &rest args)
(declare (ignore type))
- `(
e
case ,form
- ,@(%map-enum args :int-symbol)))
+ `(case ,form
+ ,@(%map-enum args :int-
quoted-
symbol)))
(defmethod to-alien-function ((type (eql 'enum)) &rest args)
(declare (ignore type))
(defmethod to-alien-function ((type (eql 'enum)) &rest args)
(declare (ignore type))
@@
-106,8
+107,8
@@
(defun ,enum-int (enum)
,@(%map-enum args :symbol-int)
(t (error 'type-error :datum enum :expected-type ',name))))
(defun ,int-enum (value)
,@(%map-enum args :symbol-int)
(t (error 'type-error :datum enum :expected-type ',name))))
(defun ,int-enum (value)
- (
e
case value
- ,@(%map-enum args :int-symbol)))
+ (case value
+ ,@(%map-enum args :int-
quoted-
symbol)))
(defmethod to-alien-form (form (type (eql ',name)) &rest args)
(declare (ignore type args))
(list ',enum-int form))
(defmethod to-alien-form (form (type (eql ',name)) &rest args)
(declare (ignore type args))
(list ',enum-int form))
@@
-142,8
+143,8
@@
(defun %map-flags (mappings op)
(unless (atom mapping)
(setq value (second mapping)))
(ecase op
(unless (atom mapping)
(setq value (second mapping)))
(ecase op
- (:symbol-int
(list symbol
value))
- (:int-symbol
(list value
symbol))
+ (:symbol-int
`(,symbol ,
value))
+ (:int-symbol
`(,value ,
symbol))
(:symbols symbol)))))
(deftype flags (&rest args)
(:symbols symbol)))))
(deftype flags (&rest args)
@@
-330,7
+331,7
@@
(defun expand-enum-type (type-number forward-p options)
(remove-if
#'(lambda (mapping) (eq (second mapping) nil)) mappings))))
`(progn
(remove-if
#'(lambda (mapping) (eq (second mapping) nil)) mappings))))
`(progn
- (register-type ',type
,(find-type-name
type-number))
+ (register-type ',type
',(find-type-init-function
type-number))
,(ecase super
(enum `(define-enum-type ,type ,@expanded-mappings))
(flags `(define-flags-type ,type ,@expanded-mappings))))))
,(ecase super
(enum `(define-enum-type ,type ,@expanded-mappings))
(flags `(define-flags-type ,type ,@expanded-mappings))))))