Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 22:59:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Allowing non-dotted attrs and non-string values.

Browse source
This commit is contained in:
Alex Shinn 2012-12-08 21:56:10 +09:00
parent 9e1034be02
commit bea3d1937c
1 changed files with 26 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
tools/chibi-doc
View file

@ -433,7 +433,8 @@ div#footer {padding-bottom: 50px}
orig-ls) orig-ls)
(else (else
(let ((name (let ((name
(or name (if (eq? 'const: (caar sig)) (cadr (cdar sig)) (caar sig))))) (or name
(if (eq? 'const: (caar sig)) (cadr (cdar sig)) (caar sig)))))
(let lp ((ls orig-ls) (rev-pre '())) (let lp ((ls orig-ls) (rev-pre '()))
(cond (cond
((or (null? ls) ((or (null? ls)
@ -462,7 +463,8 @@ div#footer {padding-bottom: 50px}
(defs (map (lambda (x) `(,(car x) ,(cadr x) ,(cdar (cddr x)))) (defs (map (lambda (x) `(,(car x) ,(cadr x) ,(cdar (cddr x))))
(filter (filter
(lambda (x) (lambda (x)
(and (pair? (third x)) (equal? file (car (third x))))) (and (pair? (third x))
(equal? file (car (third x)))))
defs)))) defs))))
(let lp ((lines '()) (cur '()) (res '())) (let lp ((lines '()) (cur '()) (res '()))
(define (collect) (define (collect)
@ -508,11 +510,17 @@ div#footer {padding-bottom: 50px}
(cond (cond
((and (eq? lang 'ffi) (get-ffi-signatures x)) ((and (eq? lang 'ffi) (get-ffi-signatures x))
=> (lambda (sigs) => (lambda (sigs)
(let ((sigs (filter (let ((sigs
(lambda (x) (filter
(memq (if (eq? 'const: (car x)) (third x) (car x)) exports)) (lambda (x)
sigs))) (memq (if (eq? 'const: (car x))
(lp '() '() (append (insert-signature cur #f sigs) res))))) (third x)
(car x))
exports))
sigs)))
(lp '()
'()
(append (insert-signature cur #f sigs) res)))))
((and (eq? lang 'scheme) (= 1 (length procs))) ((and (eq? lang 'scheme) (= 1 (length procs)))
(let* ((sig (or (get-signature (caar procs) (cdar procs) x) (let* ((sig (or (get-signature (caar procs) (cdar procs) x)
'())) '()))
@ -525,6 +533,13 @@ div#footer {padding-bottom: 50px}
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; html conversions ;; html conversions
(define (display-to-string x)
(cond ((string? x) x)
((char? x) (string x))
((symbol? x) (symbol->string x))
((number? x) (number->string x))
(else (error "don't know how to display" x))))
(define (html-display-escaped-attr str . o) (define (html-display-escaped-attr str . o)
(let ((start 0) (let ((start 0)
(end (string-length str)) (end (string-length str))
@ -551,12 +566,13 @@ div#footer {padding-bottom: 50px}
(define (html-escape-attr str) (define (html-escape-attr str)
(call-with-output-string (call-with-output-string
(lambda (out) (html-display-escaped-attr str out)))) (lambda (out) (html-display-escaped-attr (display-to-string str) out))))
(define (html-attr->string attr) (define (html-attr->string attr)
(if (cdr attr) (if (cdr attr)
(string-append (symbol->string (car attr)) (let ((val (if (pair? (cdr attr)) (cadr attr) (cdr attr))))
"=\"" (html-escape-attr (cdr attr)) "\"") (string-append (symbol->string (car attr))
"=\"" (html-escape-attr val) "\""))
(symbol->string (car attr)))) (symbol->string (car attr))))
(define (html-tag->string tag attrs) (define (html-tag->string tag attrs)