guile-gtk-general
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-GTK] Correctly honor `conditionalize' options.


From: Ludovic Courtès
Subject: [Guile-GTK] Correctly honor `conditionalize' options.
Date: Sat, 10 Nov 2007 00:11:49 -0000

From: Ludovic Courtès <address@hidden>

* build-guile-gtk-2.0 (emits-funcs)[emit-func]: Surround
  `scm_c_define_gsubr ()' with `conditionalize-start' and
  `conditionalize-end'.
  [emit-object-predicate]: New OPTS parameter.  Inherit options from the
  object so that `conditionalize' in particular is honored.  Update
  callers.
---
 build-guile-gtk-2.0 |   22 ++++++++++++----------
 1 files changed, 12 insertions(+), 10 deletions(-)

diff --git a/build-guile-gtk-2.0 b/build-guile-gtk-2.0
index 9e94754..d516b76 100644
--- a/build-guile-gtk-2.0
+++ b/build-guile-gtk-2.0
@@ -957,9 +957,11 @@ exec guile -s $0 $*
       (@ "static char s_~a[] = \"~a\";~%~%" 
         fullname (if scm-name scm-name (scmname fname)))
       (add-init
-       (@@ "scm_c_define_gsubr (s_~a, ~a, ~a, ~a, sgtk_~a);"
+       (@@ "~ascm_c_define_gsubr (s_~a, ~a, ~a, ~a, sgtk_~a);~%~a"
+           (with-output-to-string (lambda () (conditionalize-start opts)))
           fullname (if n-hack 9 n-preal) n-opt (if (or n-hack (= n-rest 1)) 1 
0)
-          fullname))
+          fullname
+           (with-output-to-string (lambda () (conditionalize-end opts)))))
       (@ "SCM~%")
       (@ "sgtk_~a (~a)~%" 
         fullname
@@ -1117,13 +1119,13 @@ exec guile -s $0 $*
                      name (syllables->string cparms ", "))))
       (set! cur-protection #f)))
 
-  (define (emit-object-predicate sym name)
+  (define (emit-object-predicate sym name opts)
     (let ((type (lookup-type sym)))
       (if (not (imported-type? sym))
-         (emit-func 'bool (append name '("p")) '((SCM obj)) 
-                    (string-append* (scmname name) "?") '()
-                    (lambda (cret cparms)
-                      (@ "~a = ~a;" cret (type-isa type (car cparms))))))))
+          (emit-func 'bool (append name '("p")) '((SCM obj)) 
+                     (string-append* (scmname name) "?") opts
+                     (lambda (cret cparms)
+                       (@ "~a = ~a;" cret (type-isa type (car cparms))))))))
 
   (define (emit-field-accessors typesym typename fields)
     (define (emit-accessor field)
@@ -1622,11 +1624,11 @@ exec guile -s $0 $*
                                 (emit-field-accessors name canonical fields))
                               (emit-converter-if-defined name canonical
                                                          options #f)
-                              (emit-object-predicate name canonical))
+                              (emit-object-predicate name canonical options))
                              ((define-boxed-union)
                               (register-boxed-union-converter name
                                                               (caddr form))
-                              (emit-object-predicate name canonical))
+                              (emit-object-predicate name canonical options))
                              ((define-ptype)
                               (register-ptype-converter name canonical
                                                         options)
@@ -1638,7 +1640,7 @@ exec guile -s $0 $*
                              ((define-object)
                               (register-object-type name canonical options)
                               (conditionalize-start options)
-                              (emit-object-predicate name canonical)
+                              (emit-object-predicate name canonical options)
                               (let ((fields (get-opt options
                                                      'fields '())))
                                 (emit-field-accessors name canonical fields))
-- 
1.5.3.4





reply via email to

[Prev in Thread] Current Thread [Next in Thread]