X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=glib%2Fgobject.generating.lisp;h=7c3a807149cf153e99225e6250bdbc52f71940f6;hb=8d777e3bbd4bfe1567af0fbd31316cf08d830b86;hp=c49f122e15df6cc024105e1566d7d7bf2e1e33cb;hpb=e75341d37baffc2e421c43b33531724616d6d839;p=cl-gtk2.git diff --git a/glib/gobject.generating.lisp b/glib/gobject.generating.lisp index c49f122..7c3a807 100644 --- a/glib/gobject.generating.lisp +++ b/glib/gobject.generating.lisp @@ -1,6 +1,7 @@ (in-package :gobject) -(defvar *lisp-name-package* (find-package :gobject)) +(defvar *lisp-name-package* (find-package :gobject) + "For internal use (used by class definitions generator). Specifies the package in which symbols are interned.") (defvar *strip-prefix* "") (defvar *lisp-name-exceptions* nil) (defvar *generation-exclusions* nil) @@ -8,8 +9,7 @@ (defvar *additional-properties* nil) (defun name->supplied-p (name) - (intern (format nil "~A-SUPPLIED-P" (symbol-name name)) - *lisp-name-package*)) + (make-symbol (format nil "~A-SUPPLIED-P" (symbol-name name)))) (defstruct property name accessor-name readable writable) @@ -139,6 +139,17 @@ (string `(foreign-funcall ,type-initializer g-type)) (symbol `(funcall ',type-initializer)))) +(defun meta-property->slot (class-name property) + `(,(property-name property) + :allocation ,(if (gobject-property-p property) :gobject-property :gobject-fn) + :g-property-type ,(if (gobject-property-p property) (gobject-property-type property) (cffi-property-type property)) + :accessor ,(intern (format nil "~A-~A" (symbol-name class-name) (property-name property)) (symbol-package class-name)) + :initarg ,(intern (string-upcase (property-name property)) (find-package :keyword)) + ,@(if (gobject-property-p property) + `(:g-property-name ,(gobject-property-gname property)) + `(:g-getter ,(cffi-property-reader property) + :g-setter ,(cffi-property-writer property))))) + (defmacro define-g-object-class (g-type-name name (&key (superclass 'g-object) (export t) @@ -146,55 +157,38 @@ type-initializer) (&rest properties)) (setf properties (mapcar #'parse-property properties)) - (let* ((superclass-properties (get superclass 'properties)) - (interface-properties (map-append (lambda (iface-name) - (get (gethash iface-name *known-interfaces*) 'properties)) - interfaces)) - (combined-properties (append superclass-properties properties interface-properties))) - `(progn - (defclass ,name (,superclass ,@(mapcar #'interface->lisp-class-name interfaces)) ()) - (register-object-type ,g-type-name ',name) + `(progn + (defclass ,name (,superclass ,@(mapcar #'interface->lisp-class-name interfaces)) + (,@(mapcar (lambda (property) (meta-property->slot name property)) properties)) + (:metaclass gobject-class) + (:g-type-name . ,g-type-name) ,@(when type-initializer - (list (type-initializer-call type-initializer))) - ,@(when export - (list `(export ',name (find-package ,(package-name (symbol-package name)))))) - (defmethod initialize-instance :before - ((object ,name) &key pointer - ,@(remove nil (mapcar #'property->method-arg - combined-properties))) - (unless (or pointer (and (slot-boundp object 'pointer) - (not (null-pointer-p (pointer object))))) - (let (arg-names arg-values arg-types) - ,@(mapcar #'gobject-property->arg-push (remove-if-not #'gobject-property-p combined-properties)) - (setf (pointer object) - (g-object-call-constructor ,g-type-name - arg-names - arg-values - arg-types) - (g-object-has-reference object) t) - ,@(mapcar #'cffi-property->initarg (remove-if-not #'cffi-property-p combined-properties))))) - ,@(loop - for property in properties - append (property->accessors name property export)) - - (eval-when (:compile-toplevel :load-toplevel :execute) - (setf (get ',name 'superclass) ',superclass - (get ',name 'properties) ',combined-properties))))) - -(defmacro define-g-interface (g-name name (&key (export t) type-initializer) &body properties) + (list `(:g-type-initializer . ,type-initializer)))) + ,@(when export + (cons `(export ',name (find-package ,(package-name (symbol-package name)))) + (mapcar (lambda (property) + `(export ',(intern (format nil "~A-~A" (symbol-name name) (property-name property)) (symbol-package name)) + (find-package ,(package-name (symbol-package name))))) + properties))))) + +(defmacro define-g-interface (g-type-name name (&key (export t) type-initializer) &body properties) (setf properties (mapcar #'parse-property properties)) `(progn - (defclass ,name () ()) + (defclass ,name () + (,@(mapcar (lambda (property) (meta-property->slot name property)) properties)) + (:metaclass gobject-class) + (:g-type-name . ,g-type-name) + (:g-interface-p . t) + ,@(when type-initializer + (list `(:g-type-initializer . ,type-initializer)))) ,@(when export - (list `(export ',name (find-package ,(package-name (symbol-package name)))))) - ,@(when type-initializer - (list (type-initializer-call type-initializer))) - ,@(loop - for property in properties - append (property->accessors name property export)) + (cons `(export ',name (find-package ,(package-name (symbol-package name)))) + (mapcar (lambda (property) + `(export ',(intern (format nil "~A-~A" (symbol-name name) (property-name property)) (symbol-package name)) + (find-package ,(package-name (symbol-package name))))) + properties))) (eval-when (:compile-toplevel :load-toplevel :execute) - (setf (get ',name 'properties) ',properties) - (setf (gethash ,g-name *known-interfaces*) ',name)))) + (setf (gethash ,g-type-name *known-interfaces*) ',name)))) (defun starts-with (name prefix) (and prefix (> (length name) (length prefix)) (string= (subseq name 0 (length prefix)) prefix))) @@ -333,14 +327,29 @@ (equal (g-type-fundamental (ensure-g-type type)) fund-type)) types)) -(defmacro define-g-enum (g-name name (&key (export t) type-initializer) &body values) +(defmacro define-g-enum (g-name name (&key (export t) type-initializer) &body values) + "Defines a GEnum type for enumeration. Generates corresponding CFFI definition. + +Example: +@begin{pre} +\(define-g-enum \"GdkGrabStatus\" grab-status () :success :already-grabbed :invalid-time :not-viewable :frozen) +\(define-g-enum \"GdkExtensionMode\" gdk-extension-mode (:export t :type-initializer \"gdk_extension_mode_get_type\") + (:none 0) (:all 1) (:cursor 2)) +@end{pre} +@arg[g-name]{a string. Specifies the GEnum name} +@arg[name]{a symbol. Names the enumeration type.} +@arg[export]{a boolean. If true, @code{name} will be exported.} +@arg[type-initializer]{a @code{NIL} or a string or a function designator. + +If non-@code{NIL}, specifies the function that initializes the type: string specifies a C function that returns the GType value and function designator specifies the Lisp function.} +@arg[values]{values for enum. Each value is a keyword or a list @code{(keyword integer-value)}. @code{keyword} corresponds to Lisp value of enumeration, and @code{integer-value} is an C integer for enumeration item. If @code{integer-value} is not specified, it is generated automatically (see CFFI manual)}" `(progn (defcenum ,name ,@values) (register-enum-type ,g-name ',name) ,@(when export (list `(export ',name (find-package ,(package-name (symbol-package name)))))) ,@(when type-initializer - (list (type-initializer-call type-initializer))))) + (list `(at-init () ,(type-initializer-call type-initializer)))))) (defun enum-value->definition (enum-value) (let ((value-name (intern (lispify-name (enum-item-nick enum-value)) @@ -362,13 +371,29 @@ ,@(mapcar #'enum-value->definition items)))) (defmacro define-g-flags (g-name name (&key (export t) type-initializer) &body values) + "Defines a GFlags type for enumeration that can combine its values. Generates corresponding CFFI definition. Values of this type are lists of keywords that are combined. + +Example: +@begin{pre} +\(define-g-flags \"GdkWindowState\" window-state () + (:withdrawn 1) + (:iconified 2) (:maximized 4) (:sticky 8) (:fullscreen 16) + (:above 32) (:below 64)) +@end{pre} +@arg[g-name]{a string. Specifies the GEnum name} +@arg[name]{a symbol. Names the enumeration type.} +@arg[export]{a boolean. If true, @code{name} will be exported.} +@arg[type-initializer]{a @code{NIL} or a string or a function designator. + +If non-@code{NIL}, specifies the function that initializes the type: string specifies a C function that returns the GType value and function designator specifies the Lisp function.} +@arg[values]{values for flags. Each value is a keyword or a list @code{(keyword integer-value)}. @code{keyword} corresponds to Lisp value of a flag, and @code{integer-value} is an C integer for flag. If @code{integer-value} is not specified, it is generated automatically (see CFFI manual)}" `(progn (defbitfield ,name ,@values) - (register-enum-type ,g-name ',name) + (register-flags-type ,g-name ',name) ,@(when export (list `(export ',name (find-package ,(package-name (symbol-package name)))))) ,@(when type-initializer - (list (type-initializer-call type-initializer))))) + (list `(at-init () ,(type-initializer-call type-initializer)))))) (defun flags-value->definition (flags-value) (let ((value-name (intern (lispify-name (flags-item-nick flags-value))