[Guile-GTK] Correctly honor `conditionalize' options.
Ludovic Courtès <[email protected]>
| Newsgroups | gmane.lisp.guile.gtk |
|---|---|
| Message-ID | <[email protected]> |
From: Ludovic Courtès <[email protected]> * 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