suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

adjust defproc* so that it only shows the white background label once, instead

Browse Source 
of once per different identifier that it is documenting

original commit: 3afba2d833bbe2349621f4851f4f41569007ed53
This commit is contained in:
Robby Findler 2012-06-25 13:41:06 -05:00
parent 0ca77cb9f5
commit 378f9c3bae
1 changed files with 6 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/scribble/private/manual-proc.rkt
View File

@ -244,7 +244,7 @@
(let loop ([p p]) (let loop ([p p])
(if (symbol? (car p)) (car p) (loop (car p))))) (if (symbol? (car p)) (car p) (loop (car p)))))
(define (do-one stx-id prototype args arg-contracts arg-vals result-contract (define (do-one stx-id prototype args arg-contracts arg-vals result-contract
first?) first? add-background-label?)
(let ([names (remq* '(... ...+) (map arg-id args))]) (let ([names (remq* '(... ...+) (map arg-id args))])
(unless (= (length names) (length (remove-duplicates names eq?))) (unless (= (length names) (length (remove-duplicates names eq?)))
(error 'defproc "duplicate argument names in prototype for ~s: ~s" (error 'defproc "duplicate argument names in prototype for ~s: ~s"
@ -353,7 +353,7 @@
(append (append
(list (list
(list (list
((if first? (add-background-label (get-label)) values) ((if add-background-label? (add-background-label (get-label)) values)
(make-flow (make-flow
(if short? (if short?
;; The single-line case: ;; The single-line case:
@ -500,7 +500,10 @@
[(ormap (lambda (a) (eq? (extract-id (car ps)) a)) accum) [(ormap (lambda (a) (eq? (extract-id (car ps)) a)) accum)
(cons #f (loop (cdr ps) accum))] (cons #f (loop (cdr ps) accum))]
[else (cons #t (loop (cdr ps) [else (cons #t (loop (cdr ps)
(cons (extract-id (car ps)) accum)))])))))) (cons (extract-id (car ps)) accum)))]))
(for/list ([p (in-list prototypes)]
[i (in-naturals)])
(= i 0))))))
(content-thunk)))) (content-thunk))))
(define-syntax-rule (defparam id arg contract desc ...) (define-syntax-rule (defparam id arg contract desc ...)