suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Adding doc based contracts

Browse Source 
svn: r15707

original commit: 18093d26e1a6a449e112a53bd9e967da3558ef82
This commit is contained in:
Jay McCarthy 2009-08-11 21:24:45 +00:00
parent 1e9aa6860a
commit a25a225d89
13 changed files with 104 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/scribble/base.ss
View File

@ -146,10 +146,12 @@
;; ----------------------------------------
; XXX unknown contracts
(provide intern-taglet
module-path-index->taglet
module-path-prefix->string
doc-prefix)
(provide/contract
[module-path-prefix->string (module-path? . -> . string?)])
(require syntax/modcollapse
;; Needed to normalize planet version numbers:
@ -242,7 +244,8 @@
()
#:rest (listof pre-flow?)
item?)])
(provide item?)
(provide/contract
[item? (any/c . -> . boolean?)])
(define (itemlist #:style [style plain] . items)
(let ([flows (map an-item-flow items)])
@ -557,8 +560,15 @@
;; ----------------------------------------
(provide section-index index index* as-index index-section
get-index-entries index-block)
; XXX unknown contract
(provide get-index-entries)
(provide/contract
[index-block (-> delayed-block?)]
[index (((or/c string? (listof string?))) () #:rest (listof any/c) . ->* . index-element?)] ; XXX pre-content docs
[index* (((listof string?) (listof any/c)) () #:rest (listof any/c) . ->* . index-element?)] ; XXX pre-content docs and first any/c wrong in docs
[as-index (() () #:rest (listof any/c) . ->* . index-element?)] ; XXX pre-content docs
[section-index (() () #:rest (listof string?) . ->* . part-index-decl?)]
[index-section (() (#:tag (or/c false/c string?)) . ->* . part?)])
(define (section-index . elems)
(make-part-index-decl (map content->string elems) elems))
@ -730,8 +740,10 @@
;; ----------------------------------------
(provide table-of-contents
local-table-of-contents)
(provide/contract
[table-of-contents (-> delayed-block?)]
; XXX Should have a style/c contract
[local-table-of-contents (() (#:style any/c) . ->* . delayed-block?)])
(define (table-of-contents)
(make-delayed-block

19
collects/scribble/private/manual-bib.ss
View File

@ -1,14 +1,21 @@
#lang scheme/base
(require "../decode.ss"
(require scheme/contract
"../decode.ss"
"../struct.ss"
"../basic.ss"
"manual-utils.ss"
"manual-style.ss")
(provide cite
bib-entry
(rename-out [a-bib-entry? bib-entry?])
bibliography)
(define-struct a-bib-entry (key val))
(provide/contract
[cite ((string?) () #:rest (listof string?) . ->* . element?)] ; XXX docs wrong
[bib-entry ((#:key string? #:title any/c) ; XXX bad contracts
(#:is-book? any/c #:author any/c #:location any/c #:date any/c #:url any/c)
. ->* .
a-bib-entry?)]
[rename a-bib-entry? bib-entry? (any/c . -> . boolean?)]
[bibliography (() (#:tag string?) #:rest (listof a-bib-entry?) . ->* . part?)])
(define (cite key . keys)
(make-element
@ -27,8 +34,6 @@
(loop (cdr keys))))))
"]")))
(define-struct a-bib-entry (key val))
(define (bib-entry #:key key
#:title title
#:is-book? [is-book? #f]

6
collects/scribble/private/manual-bind.ss
View File

@ -7,6 +7,7 @@
"../manual-struct.ss"
"manual-ex.ss"
scheme/string
scheme/contract
scheme/list
scheme/class
scheme/stxparam
@ -25,12 +26,15 @@
with-exporting-libraries
id-to-target-maker
id-to-form-target-maker
defidentifier
*sig-elem
(struct-out sig)
;; public:
; XXX unknown contract
make-binding-redirect-elements
sigelem)
(provide/contract
; XXX any/c should be boolean?
[defidentifier ((identifier?) (#:form? any/c #:index? any/c #:show-libs? any/c) . ->* . element?)])
(define (gen-absolute-tag)
`(abs ,(make-generated-tag)))

1
collects/scribble/private/manual-ex.ss
View File

@ -1,6 +1,7 @@
#lang scheme/base
(require "../struct.ss")
; XXX unknown contracts
(provide (struct-out exporting-libraries)
current-signature)

1
collects/scribble/private/manual-form.ss
View File

@ -18,6 +18,7 @@
(for-syntax scheme/base)
(for-label scheme/base))
(provide defform defform* defform/subs defform*/subs defform/none
defidform
specform specform/subs

7
collects/scribble/private/manual-method.ss
View File

@ -6,11 +6,12 @@
"manual-scheme.ss"
(for-syntax scheme/base))
(provide ;; public:
method xmethod)
; XXX unknown contracts
(provide *method **method
method-tag
name-this-object
;; public:
method xmethod)
name-this-object)
(define-syntax-rule (method a b)
(*method 'b (quote-syntax a)))

5
collects/scribble/private/manual-proc.ss
View File

@ -21,9 +21,10 @@
(provide defproc defproc* defstruct
defparam defparam* defboolparam
defthing defthing* defthing/proc
defthing defthing*
defthing/proc ; XXX unknown contract
;; private:
*defthing)
*defthing) ; XXX unknown contract
(define dots0
(make-element meta-color (list "...")))

5
collects/scribble/private/manual-scheme.ss
View File

@ -16,8 +16,9 @@
schemeinput
schememod
scheme SCHEME scheme/form schemeresult schemeid
schememodname schememodlink
indexed-scheme
schememodname
schememodlink indexed-scheme
; XXX doc says this is function
schemelink)
(define-code schemeblock0 to-paragraph)

48
collects/scribble/private/manual-style.ss
View File

@ -7,35 +7,47 @@
(only-in "../core.ss" make-style plain)
"manual-utils.ss"
scheme/list
scheme/contract
scheme/string)
(provide PLaneT etc
litchar
image (rename-out [image image/plain]) onscreen menuitem defterm
schemefont schemevalfont schemeresultfont schemeidfont schemevarfont
schemeparenfont schemekeywordfont schememetafont schememodfont
schemeerror schemeoutput
filepath exec envvar Flag DFlag PFlag DPFlag
indexed-file indexed-envvar
(rename-out [hyperlink link])
(provide (rename-out [hyperlink link])
(rename-out [other-doc other-manual])
(rename-out [centered centerline])
image
(rename-out [image image/plain])
itemize
procedure
idefterm
t inset-flow
pidefterm
hash-lang
commandline
void-const undefined-const
aux-elem
math)
aux-elem)
; XXX pre-content
(define styling-f/c
(() () #:rest (listof any/c) . ->* . element?))
(define-syntax-rule (provide-styling id ...)
(provide/contract [id styling-f/c] ...))
(provide-styling onscreen defterm
schememodfont schemeoutput ; XXX no docs
schemeerror schemefont schemevalfont schemeresultfont schemeidfont schemevarfont
schemeparenfont schemekeywordfont schememetafont
filepath exec envvar Flag DFlag PFlag DPFlag math
procedure
indexed-file indexed-envvar idefterm pidefterm)
(provide/contract
[PLaneT element?]
[void-const element?]
[undefined-const element?]
[hash-lang (-> element?)]
[etc string?]
[inset-flow (() () #:rest (listof any/c) . ->* . any/c)] ; XXX no docs and bad return contract
[litchar (() () #:rest (listof string?) . ->* . element?)] ; XXX docs wrong
[t (() () #:rest (listof any/c) . ->* . paragraph?)] ; XXX pre-content
[commandline (() () #:rest (listof any/c) . ->* . paragraph?)] ; XXX pre-content
[menuitem (string? string? . -> . element?)])
(define PLaneT (make-element "planetName" '("PLaneT")))
(define etc "etc.") ; so we can fix the latex space, one day
(define (litchar . strs)
; XXX Remove not-contract
(unless (andmap string? strs)
(raise-type-error 'litchar "strings" strs))
(let ([s (string-append* (map (lambda (s) (regexp-replace* "\n" s " "))

9
collects/scribble/private/manual-tech.ss
View File

@ -1,11 +1,16 @@
#lang scheme/base
(require "../decode.ss"
(require scheme/contract
"../decode.ss"
"../struct.ss"
"../basic.ss"
"manual-utils.ss"
"manual-style.ss")
(provide deftech tech techlink)
(provide/contract
; XXX boolean? and precontent?
[deftech (() (#:style? any/c) #:rest (listof any/c) . ->* . element?)]
[tech (() (#:doc (or/c module-path? false/c) #:tag-prefixes (or/c (listof string?) false/c)) #:rest (listof any/c) . ->* . element?)]
[techlink (() (#:doc (or/c module-path? false/c) #:tag-prefixes (or/c (listof string?) false/c)) #:rest (listof any/c) . ->* . element?)])
(define (*tech make-elem style doc prefix s)
(let* ([c (decode-content s)]

6
collects/scribble/private/manual-unit.ss
View File

@ -11,12 +11,12 @@
"manual-bind.ss"
"manual-ex.ss"
"manual-proc.ss"
scheme/contract
(for-syntax scheme/base)
(for-label scheme/base))
(provide defsignature
defsignature/splice
signature-desc
sigelem)
(define-syntax-rule (defsignature name (super ...) body ...)
@ -41,6 +41,10 @@
(define (signature-desc . l)
(make-sig-desc l))
(provide/contract
; XXX preflow & docs
[signature-desc (() () #:rest (listof any/c) . ->* . sig-desc?)])
(define (*defsignature stx-id supers body-thunk indent?)
(*defthing
(list stx-id)

14
collects/scribble/private/manual-utils.ss
View File

@ -2,13 +2,17 @@
(require "../struct.ss"
"../decode.ss"
"../base.ss"
scheme/contract
scheme/list)
(provide spacer doc-prefix
to-flow
flow-spacer flow-empty-line
make-table-if-necessary
max-proto-width)
(provide doc-prefix)
(provide/contract
[spacer element?]
[to-flow (any/c . -> . flow?)] ; XXX element?
[flow-spacer flow?]
[flow-empty-line flow?]
[make-table-if-necessary (any/c list? . -> . (list/c (or/c omitable-paragraph? table?)))] ; XXX element?
[max-proto-width exact-nonnegative-integer?])
(define spacer (hspace 1))

10
collects/scribble/private/manual-vars.ss
View File

@ -3,18 +3,20 @@
"../scheme.ss"
"../struct.ss"
(only-in "../core.ss" style-name)
scheme/contract
(for-syntax scheme/base
syntax/kerncase
syntax/boundmap)
(for-label scheme/base
scheme/class))
(define-struct (box-splice splice) ())
(provide/contract
[struct (box-splice splice) ([run list?])]) ; XXX ugly copying
(provide deftogether
with-scheme-variables
with-togetherable-scheme-variables
(struct-out box-splice))
(define-struct (box-splice splice) ())
with-togetherable-scheme-variables)
(begin-for-syntax (define-struct deftogether-tag () #:omit-define-syntaxes))