[Guile-commits] branch main updated: make-foreign-object-type: add #:super to provide superclasses

[Rob Browning]

This is an automated email from the git hooks/post-receive script.

rlb pushed a commit to branch main
in repository guile.

The following commit(s) were added to refs/heads/main by this push:
     new 779a83d9c make-foreign-object-type: add #:super to provide superclasses
779a83d9c is described below

commit 779a83d9c682345802f9a605cb8e2b4892129316
Author: Rob Browning <rlb@defaultvalue.org>
AuthorDate: Thu Apr 18 00:55:16 2024 -0500

    make-foreign-object-type: add #:super to provide superclasses
    
    * module/system/foreign-object.scm (make-foreign-object-type): allow
    specification of superclasses via #:super.
---
 NEWS                             | 4 ++++
 doc/ref/api-foreign-objects.texi | 7 +++++--
 module/system/foreign-object.scm | 9 +++++----
 3 files changed, 14 insertions(+), 6 deletions(-)

diff --git a/NEWS b/NEWS
index 03b4d14f1..c9a713c1e 100644
--- a/NEWS
+++ b/NEWS
@@ -37,6 +37,10 @@ SEEK_HOLE values can now be passed to the 'seek' procedure 
to change
 file offset to the next piece of data or to the next hole in sparse
 files.  See "Random Access" in the manual for details.
 
+** ((scm foreign-object) make-foreign-object-type) now supports #:super
+
+A list of superclasses can now be provided via #:super.
+
 * Bug fixes
 
 ** Fix incorrect comparison between exact and inexact numbers
diff --git a/doc/ref/api-foreign-objects.texi b/doc/ref/api-foreign-objects.texi
index f27f9c154..b89c2ff64 100644
--- a/doc/ref/api-foreign-objects.texi
+++ b/doc/ref/api-foreign-objects.texi
@@ -103,11 +103,14 @@ and Scheme}, for some examples.
 (use-modules (system foreign-object))
 @end example
 
-@deffn {Scheme Procedure} make-foreign-object-type name slots [#:finalizer=#f]
+@deffn {Scheme Procedure} make-foreign-object-type name slots [#:finalizer=#f] 
[#:supers='()]
+
 Make a new foreign object type.  See the above documentation for
 @code{scm_make_foreign_object_type}; these functions are exactly
 equivalent, except for the way in which the finalizer gets attached to
-instances (an internal detail).
+instances (an internal detail), and the fact that this function accepts
+an optional list of superclasses, which will be paseed to
+@code{make-class}.
 
 The resulting value is a GOOPS class.  @xref{GOOPS}, for more on classes
 in Guile.
diff --git a/module/system/foreign-object.scm b/module/system/foreign-object.scm
index a8022b9c0..3f05ccaad 100644
--- a/module/system/foreign-object.scm
+++ b/module/system/foreign-object.scm
@@ -1,6 +1,6 @@
 ;;; Wrapping foreign objects in Scheme
 
-;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
+;;; Copyright (C) 2014, 2015, 2024 Free Software Foundation, Inc.
 ;;; 
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -46,7 +46,8 @@
     instance))
 
 (define* (make-foreign-object-type name slots #:key finalizer
-                                   (getters (map (const #f) slots)))
+                                   (getters (map (const #f) slots))
+                                   (supers '()))
   (unless (symbol? name)
     (error "type name should be a symbol" name))
   (unless (or (not finalizer) (procedure? finalizer))
@@ -61,11 +62,11 @@
                      slots
                      getters)))
     (if finalizer
-        (make-class '() dslots #:name name
+        (make-class supers dslots #:name name
                     #:finalizer finalizer
                     #:static-slot-allocation? #t
                     #:metaclass <foreign-class-with-finalizer>)
-        (make-class '() dslots #:name name
+        (make-class supers dslots #:name name
                     #:static-slot-allocation? #t
                     #:metaclass <foreign-class>))))