;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;; $Id: defpackage.lisp,v 1.27 2008/10/09 18:20:52 espen Exp $
+;; $Id: defpackage.lisp,v 1.28 2008/11/04 03:22:23 espen Exp $
(defpackage "GLIB"
;; Symbols from gparam.lisp
(:export "GVALUE" "GVALUE-INIT" "GVALUE-NEW" "GVALUE-FREE" "GVALUE-TYPE"
"GVALUE-GET" "GVALUE-SET" "GVALUE-UNSET" "VALUE-P" "WITH-GVALUE"
- "+GVALUE-SIZE+" "+GVALUE-VALUE-OFFSET+" "PARAM-FLAG-TYPE" "PARAM"
+ "+GVALUE-SIZE+" "+GVALUE-VALUE-OFFSET+" "GVALUE-STATIC-P"
+ "PARAM-FLAG-TYPE" "PARAM"
"PARAM-CHAR" "PARAM-UNSIGNED-CHAR" "PARAM-BOOLEAN" "PARAM-INT"
"PARAM-UNSIGNED-INT" "PARAM-LONG" "PARAM-UNSIGNED-LONG"
"PARAM-UNICHAR" "PARAM-ENUM" "PARAM-FLAGS" "PARAM-SINGLE-FLOAT"
;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;; $Id: gobject.lisp,v 1.58 2008/10/09 18:20:52 espen Exp $
+;; $Id: gobject.lisp,v 1.59 2008/11/04 03:22:23 espen Exp $
(in-package "GLIB")
(declare (ignore signal-unbound-p))
(let* ((type (slot-definition-type slotd))
(pname (slot-definition-pname slotd))
- (reader (reader-function type :ref :get)))
+ (get-reader (reader-function type :ref :get))
+ (peek-reader (reader-function type :ref :peek)))
#'(lambda (object)
(with-memory (gvalue +gvalue-size+)
(%gvalue-init gvalue (find-type-number type))
(%object-get-property object pname gvalue)
- (funcall reader gvalue +gvalue-value-offset+)))))
+ (if (gvalue-static-p gvalue)
+ (funcall peek-reader gvalue +gvalue-value-offset+)
+ (funcall get-reader gvalue +gvalue-value-offset+))))))
(defmethod compute-slot-writer-function :around ((slotd effective-property-slot-definition))
(if (construct-only-property-p slotd)
;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;; $Id: gparam.lisp,v 1.26 2007/08/20 10:50:25 espen Exp $
+;; $Id: gparam.lisp,v 1.27 2008/11/04 03:22:23 espen Exp $
(in-package "GLIB")
(defconstant +gvalue-size+ (size-of-gvalue))
(defconstant +gvalue-value-offset+
(max (size-of 'type-number) (type-alignment '(unsigned-byte 64))))
+(defconstant +gvalue-flags-offset+
+ (+ +gvalue-value-offset+ (size-of '(unsigned-byte 64))))
+(defconstant +gvalue-nocopy-contents-flag+ 27)
(defbinding (%gvalue-init "g_value_init") () nil
(value gvalue)
;; This will signal an error if the type hierarchy is unknown
(type-from-number type-number t))))))
+(let ((flags-reader nil))
+ (defun gvalue-static-p (gvalue)
+ (unless flags-reader
+ (setf flags-reader (reader-function 'unsigned-int)))
+ (prog1
+ (ldb-test (byte 1 +gvalue-nocopy-contents-flag+)
+ (funcall flags-reader gvalue +gvalue-flags-offset+))
+ (force-output))))
+
(defun gvalue-get (gvalue)
(funcall (reader-function (gvalue-type gvalue))
gvalue +gvalue-value-offset+))
gvalue +gvalue-value-offset+))
(defun gvalue-take (gvalue)
- (funcall (reader-function (gvalue-type gvalue) :ref :get)
+ (funcall (reader-function (gvalue-type gvalue)
+ :ref (if (gvalue-static-p gvalue) :peek :get))
gvalue +gvalue-value-offset+))
(defun gvalue-set (gvalue value)