X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/dcb31db65bd37358773232f94a915ee0caad97b9..bdf1567aa37a86469f0825e0ccc87d34039b7c4b:/glib/genums.lisp diff --git a/glib/genums.lisp b/glib/genums.lisp index 3a670e6..6624332 100644 --- a/glib/genums.lisp +++ b/glib/genums.lisp @@ -1,21 +1,26 @@ -;; Common Lisp bindings for GTK+ v2.0 -;; Copyright (C) 2000-2001 Espen S. Johnsen +;; Common Lisp bindings for GTK+ v2.x +;; Copyright 2000-2005 Espen S. Johnsen ;; -;; 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. +;; Permission is hereby granted, free of charge, to any person obtaining +;; a copy of this software and associated documentation files (the +;; "Software"), to deal in the Software without restriction, including +;; without limitation the rights to use, copy, modify, merge, publish, +;; distribute, sublicense, and/or sell copies of the Software, and to +;; permit persons to whom the Software is furnished to do so, subject to +;; the following conditions: ;; -;; 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. +;; The above copyright notice and this permission notice shall be +;; included in all copies or substantial portions of the Software. ;; -;; 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 +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: genums.lisp,v 1.12 2005/03/06 17:26:23 espen Exp $ +;; $Id: genums.lisp,v 1.18 2006/02/19 22:25:31 espen Exp $ (in-package "GLIB") @@ -52,6 +57,9 @@ (defmethod to-alien-form (form (type (eql 'enum)) &rest args) (t (error 'type-error :datum ,form :expected-type '(enum ,@args))))) +(defmethod callback-from-alien-form (form (type (eql 'enum)) &rest args) + (apply #'from-alien-form form type args)) + (defmethod from-alien-form (form (type (eql 'enum)) &rest args) (declare (ignore type)) `(case ,form @@ -82,7 +90,8 @@ (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)) + #'(lambda (location &optional (offset 0) weak-p) + (declare (ignore weak-p)) (funcall function (funcall reader location offset))))) (defun enum-int (enum type) @@ -129,7 +138,8 @@ (defmethod writer-function ((type (eql ',name)) &rest args) (defmethod reader-function ((type (eql ',name)) &rest args) (declare (ignore type args)) (let ((reader (reader-function 'signed))) - #'(lambda (location &optional (offset 0)) + #'(lambda (location &optional (offset 0) weak-p) + (declare (ignore weak-p)) (,int-enum (funcall reader location offset)))))))) @@ -166,12 +176,15 @@ (defmethod to-alien-form (flags (type (eql 'flags)) &rest args) (t (error 'type-error :datum ,flags :expected-type '(,type ,@args))))))) -(defmethod from-alien-form (int (type (eql 'flags)) &rest args) +(defmethod callback-from-alien-form (form (type (eql 'flags)) &rest args) + (apply #'from-alien-form form type args)) + +(defmethod from-alien-form (value (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))) + for (int symbol) in ',(%map-flags args :int-symbol) + when (= (logand ,value int) int) + collect symbol)) (defmethod to-alien-function ((type (eql 'flags)) &rest args) (declare (ignore type)) @@ -187,11 +200,11 @@ (defmethod to-alien-function ((type (eql 'flags)) &rest args) (defmethod from-alien-function ((type (eql 'flags)) &rest args) (declare (ignore type)) (let ((mappings (%map-flags args :int-symbol))) - #'(lambda (int) + #'(lambda (value) (loop - for mapping in mappings - unless (zerop (logand int (first mapping))) - collect (second mapping))))) + for (int symbol) in mappings + when (= (logand value int) int) + collect symbol)))) (defmethod writer-function ((type (eql 'flags)) &rest args) (declare (ignore type)) @@ -204,7 +217,8 @@ (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)) + #'(lambda (location &optional (offset 0) weak-p) + (declare (ignore weak-p)) (funcall function (funcall reader location offset))))) @@ -231,9 +245,9 @@ (defun ,flags-int (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))) + for (int symbol) in ',(%map-flags args :int-symbol) + when(= (logand value int) int) + collect symbol)) (defmethod alien-type ((type (eql ',name)) &rest args) (declare (ignore type args)) (alien-type 'flags)) @@ -260,7 +274,8 @@ (defmethod writer-function ((type (eql ',name)) &rest args) (defmethod reader-function ((type (eql ',name)) &rest args) (declare (ignore type args)) (let ((reader (reader-function 'signed))) - #'(lambda (location &optional (offset 0)) + #'(lambda (location &optional (offset 0) weak-p) + (declare (ignore weak-p)) (,int-flags (funcall reader location offset)))))))) @@ -271,8 +286,8 @@ (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))) + (size (foreign-size (find-class class))) + (proxy (ensure-proxy-instance class sap))) (dotimes (i length) (with-slots (location nickname value) proxy (setf location sap)