[Top][All Lists]
[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: |
Sun, 11 Nov 2007 12:59:33 -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