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

Don't generate implicit docs for already explicitly documented procs and macros.

Browse source
This commit is contained in:
Alex Shinn 2014-07-24 22:44:16 +09:00
parent bb0767eb45
commit 706fdad575
1 changed files with 36 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

57
lib/chibi/doc.scm
View file

@ -614,7 +614,7 @@ div#footer {padding-bottom: 50px}
;; (name value line) ;; (name value line)
`(,(car x) ,(cadr x) ,line)))) `(,(car x) ,(cadr x) ,line))))
all-defs))) all-defs)))
(let lp ((lines '()) (cur '()) (res '()) (last-line 0)) (let lp ((lines '()) (cur '()) (res '()) (ids '()) (last-line 0))
(define (collect) (define (collect)
(if (pair? lines) (if (pair? lines)
(append (append
@ -624,13 +624,22 @@ div#footer {padding-bottom: 50px}
scribble-parse)) scribble-parse))
cur) cur)
cur)) cur))
(define (get-ids sxml)
(match sxml
(((or 'procedure 'macro) str)
(list
(string->symbol
(string-trim (car (string-split str))
(lambda (ch) (or (eq? ch #\() (eq? ch #\))))))))
((x ...) (append-map get-ids x))
(else '())))
(skip-horizontal-whitespace in) (skip-horizontal-whitespace in)
(cond (cond
((eof-object? (peek-char in)) ((eof-object? (peek-char in))
(append (collect) res)) (append (collect) res))
((eqv? #\newline (peek-char in)) ((eqv? #\newline (peek-char in))
(read-char in) (read-char in)
(lp lines cur res last-line)) (lp lines cur res ids last-line))
((eqv? #\; (peek-char in)) ((eqv? #\; (peek-char in))
(read-char in) (read-char in)
(cond (cond
@ -638,20 +647,22 @@ div#footer {padding-bottom: 50px}
(begin (read-char in) (eqv? #\> (peek-char in)))) (begin (read-char in) (eqv? #\> (peek-char in))))
(read-char in) (read-char in)
(if (eqv? #\space (peek-char in)) (read-char in)) (if (eqv? #\space (peek-char in)) (read-char in))
(lp (cons (read-line in) lines) cur res last-line)) (lp (cons (read-line in) lines) cur res ids last-line))
(else (else
(let lp () (let lp ()
(cond ((eqv? #\; (peek-char in)) (cond ((eqv? #\; (peek-char in))
(read-char in) (read-char in)
(lp)))) (lp))))
(let ((line (read-line in)) (let* ((line (read-line in))
(cur (collect))) (cur (collect))
(ids (append (get-ids cur) ids)))
;; ";;/" attaches the docs to the preceding form ;; ";;/" attaches the docs to the preceding form
(if (equal? line "/") (if (equal? line "/")
(lp '() '() (append cur res) last-line) (lp '() '() (append cur res) ids last-line)
(lp '() cur res last-line)))))) (lp '() cur res ids last-line))))))
(else ;; found a top-level expression (else ;; found a top-level expression
(let* ((cur (collect)) (let* ((cur (collect))
(ids (append (get-ids cur) ids))
(form (read in)) (form (read in))
(line (port-line in)) (line (port-line in))
;; find all procedures defined by form ;; find all procedures defined by form
@ -674,26 +685,30 @@ div#footer {padding-bottom: 50px}
((and strict? ((and strict?
(or (not (pair? sigs)) (not (assq (caar sigs) defs)))) (or (not (pair? sigs)) (not (assq (caar sigs) defs))))
;; drop unrelated docs in strict mode ;; drop unrelated docs in strict mode
(lp '() '() res line)) (lp '() '() res ids line))
((and (eq? lang 'ffi) (pair? sigs)) ((and (eq? lang 'ffi) (pair? sigs))
(lp '() '() (append (insert-signature cur #f sigs) res) line)) (lp '() '() (append (insert-signature cur #f sigs) res)
ids line))
((and (eq? lang 'scheme) (= 1 (length procs))) ((and (eq? lang 'scheme) (= 1 (length procs)))
(lp '() '() (append (insert-signature cur (caar procs) sigs) (lp '() '() (append (insert-signature cur (caar procs) sigs)
res) res)
line)) ids line))
((and (null? procs) ((and (null? procs)
(assq (match form (let ((id (match form
(('define (name . x) . y) name) (('define (name . x) . y) name)
(((or 'define 'define-syntax) name . x) name) (((or 'define 'define-syntax) name . x) name)
(((or 'define-c 'define-c-const) t (name . x) . y) (((or 'define-c 'define-c-const)
name) t (name . x) . y)
(((or 'define-c 'define-c-const) t name . x) name)
name) (((or 'define-c 'define-c-const) t name . x)
(else #f)) name)
all-defs)) (else #f))))
(lp '() '() (append (insert-signature cur #f sigs) res) line)) (and (not (memq id ids))
(assq id all-defs))))
(lp '() '() (append (insert-signature cur #f sigs) res)
ids line))
(else (else
(lp '() '() (append cur res) line))))))))))) (lp '() '() (append cur res) ids line)))))))))))
;; utility to get the source position of an object ;; utility to get the source position of an object
(define (object-source x) (define (object-source x)