Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
39 changes: 15 additions & 24 deletions scribble-lib/scribble/private/manual-class.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -48,14 +48,9 @@

(define (id-info id)
(define b (identifier-label-binding id))
(if b
(list (caddr b)
(list-ref b 3)
(list-ref b 4)
(list-ref b 5)
(list-ref b 6))
(error 'scribble "no class/interface/mixin information for identifier: ~e"
id)))
(unless b
(error 'scribble "no class/interface/mixin information for identifier: ~e" id))
(list (caddr b) (list-ref b 3) (list-ref b 4) (list-ref b 5) (list-ref b 6)))

(define (make-inherited-table r d ri decl)
(define start
Expand Down Expand Up @@ -155,11 +150,11 @@
null))

(define (build-body decl body)
`(,@(map (lambda (i)
(cond [(constructor? i) ((constructor-def i))]
[(meth? i) ((meth-def i))]
[else i]))
body)
`(,@(for/list ([i (in-list body)])
(cond
[(constructor? i) ((constructor-def i))]
[(meth? i) ((meth-def i))]
[else i]))
,(make-delayed-block (lambda (r d ri) (make-inherited-table r d ri decl)))))

(define (*include-class/title decl link?)
Expand Down Expand Up @@ -408,17 +403,13 @@
(datum->syntax n (syntax-e n) (list 'src 1 3 4 1)))
(list 'src 1 0 1 5))]
[(((kw ...) ...) ...)
(map (lambda (ids)
(map (lambda (arg)
(if (and (pair? (syntax-e arg))
(eq? (syntax-e #'mode) 'new))
(list (string->keyword
(symbol->string
(syntax-e
(car (syntax-e arg))))))
null))
(syntax->list ids)))
(syntax->list #'((arg ...) ...)))])
(for/list ([ids (in-list (syntax->list #'((arg ...) ...)))])
(map (lambda (arg)
(if (and (pair? (syntax-e arg)) (eq? (syntax-e #'mode) 'new))
(list (string->keyword
(symbol->string (syntax-e (car (syntax-e arg))))))
null))
(syntax->list ids)))])
#'(make-constructor (lambda ()
(defproc* #:mode mode #:within name
[[(make [kw ... . arg] ...) result] ...]
Expand Down
17 changes: 10 additions & 7 deletions scribble-lib/scribble/private/manual-code.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -340,16 +340,19 @@
(list 'function start end 1)] ; this looses information
[_ tok])))

(define (make-test-result lst)
(define-values (res _)
(for/fold ([result null] [count 12])
(define (make-test-result lst)
(define res
(for/fold ([result null]
[count 12]
#:result result)
([p lst])
(define next (+ count (second p)))
(define r (if (eq? (first p) 'function) 1 0))
(values
(cons (list (first p) count next r) result)
next)))
(list* `(function 0 5 1) `(white-space 5 6 0) `(function 6 12 1) `(function 6 12 1)
(values (cons (list (first p) count next r) result) next)))
(list* `(function 0 5 1)
`(white-space 5 6 0)
`(function 6 12 1)
`(function 6 12 1)
(reverse res)))

(check-equal?
Expand Down
37 changes: 16 additions & 21 deletions scribble-lib/scribble/private/manual-form.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -413,11 +413,12 @@
flow-empty-line flow-empty-line)
(list (to-flow nonterm) flow-empty-line (to-flow "=") flow-empty-line
(make-flow (list (car clauses))))
(map (lambda (clause)
(list flow-empty-line flow-empty-line
(to-flow "|") flow-empty-line
(make-flow (list clause))))
(cdr clauses))))
(for/list ([clause (in-list (cdr clauses))])
(list flow-empty-line
flow-empty-line
(to-flow "|")
flow-empty-line
(make-flow (list clause))))))
nonterms clauseses))))

(define (*racketrawgrammar style nonterm clause1 . clauses)
Expand All @@ -426,11 +427,8 @@
(define (*racketgrammar lits s-expr clauseses-thunk)
(define l (clauseses-thunk))
(*racketrawgrammars #f
(map (lambda (x)
(make-element #f
(list (hspace 2)
(car x))))
l)
(for/list ([x (in-list l)])
(make-element #f (list (hspace 2) (car x))))
(map cdr l)))

(define (*var id)
Expand All @@ -445,14 +443,11 @@
(append
(list (list flow-empty-line))
(list (list (make-flow
(map (lambda (c)
(make-table
"argcontract"
(list
(list (to-flow (hspace 2))
(to-flow ((car c)))
flow-spacer
(to-flow ":")
flow-spacer
(make-flow (list ((cadr c))))))))
contract-procs)))))))
(for/list ([c (in-list contract-procs)])
(make-table "argcontract"
(list (list (to-flow (hspace 2))
(to-flow ((car c)))
flow-spacer
(to-flow ":")
flow-spacer
(make-flow (list ((cadr c))))))))))))))
94 changes: 44 additions & 50 deletions scribble-lib/scribble/private/manual-proc.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -857,42 +857,38 @@
(make-just-context (car name)
(car (syntax-e stx-id)))
stx-id)])
(if link?
(let ()
(define (gen defn?)
((if defn? annote-exporting-library values)
(to-element #:defn? defn? name-id)))
(define content (gen #t))
(define ref-content (gen #f))
(make-target-element*
(lambda (s c t)
(make-toc-target2-element s c t ref-content))
(if (pair? name)
(car (syntax-e stx-id))
stx-id)
content
(let ([name (if (pair? name) (car name) name)])
(list* (list 'info name)
(list 'type 'struct: name)
(list 'predicate name '?)
(append
(if cname-id
(list (list 'constructor (syntax-e cname-id)))
null)
(map (lambda (f)
(list 'accessor name '-
(field-name f)))
fields)
(filter-map
(lambda (f)
(and (or (not immutable?)
(and (pair? (car f))
(memq '#:mutable
(car f))))
(list 'mutator 'set- name '-
(field-name f) '!)))
fields))))))
(to-element #:defn? #t name-id)))])
(cond
[link?
(define (gen defn?)
((if defn? annote-exporting-library values) (to-element #:defn? defn?
name-id)))
(define content (gen #t))
(define ref-content (gen #f))
(make-target-element*
(lambda (s c t) (make-toc-target2-element s c t ref-content))
(if (pair? name)
(car (syntax-e stx-id))
stx-id)
content
(let ([name (if (pair? name)
(car name)
name)])
(list* (list 'info name)
(list 'type 'struct: name)
(list 'predicate name '?)
(append
(if cname-id
(list (list 'constructor (syntax-e cname-id)))
null)
(map (lambda (f) (list 'accessor name '- (field-name f)))
fields)
(filter-map
(lambda (f)
(and (or (not immutable?)
(and (pair? (car f)) (memq '#:mutable (car f))))
(list 'mutator 'set- name '- (field-name f) '!)))
fields)))))]
[else (to-element #:defn? #t name-id)]))])
(if (pair? name)
(make-element
#f
Expand All @@ -913,27 +909,25 @@
(map sym-length
(append (if (pair? name) name (list name))
(map field-name fields)))
(map (lambda (f)
(match (car f)
[(? symbol?) 0]
[(list name) 2] ;; the extra [ ]
[(list* name field-opts)
;; '[' ']'
(apply + 2
(for/list ([field-opt (in-list field-opts)])
;; and " #:"
(+ 3 (string-length (keyword->string field-opt)))))]))
fields)))])
(for/list ([f (in-list fields)])
(match (car f)
[(? symbol?) 0]
[(list name) 2] ;; the extra [ ]
[(list* name field-opts)
;; '[' ']'
(apply +
2
(for/list ([field-opt (in-list field-opts)])
;; and " #:"
(+ 3 (string-length (keyword->string field-opt)))))]))))])
(cond
[(and (short-width . < . max-proto-width)
(not keyword-modifiers?))
;; All on one line:
(make-omitable-paragraph
(list
(to-element
`(,(racket struct)
,the-name
,(map field-view fields)))))]
(list (racket struct) the-name (map field-view fields)))))]
[else
;; Multi-line view (leaving out last paren if keywords follow):
(define one-right-column?
Expand Down
57 changes: 27 additions & 30 deletions scribble-lib/scribble/private/manual-style.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -22,10 +22,11 @@
itemize
aux-elem
code-inset)
(provide/contract [filebox (((or/c core:element? string?)) () #:rest (listof pre-flow?) . ->* . block?)])
(provide (contract-out
[filebox (((or/c core:element? string?)) () #:rest (listof pre-flow?) . ->* . block?)]))

(define styling-f/c
(() () #:rest (listof pre-content?) . ->* . element?))
(-> pre-content? ... element?))
(define-syntax-rule (provide-styling id ...)
(provide/contract [id styling-f/c] ...))
(provide-styling racketmodfont racketoutput
Expand Down Expand Up @@ -53,35 +54,32 @@

(provide void-const
undefined-const)
(provide/contract
[PLaneT element?]
[hash-lang (-> element?)]
[etc element?]
[inset-flow (() () #:rest (listof pre-content?) . ->* . nested-flow?)]
[litchar (() () #:rest (listof string?) . ->* . element?)]
[t (() () #:rest (listof pre-content?) . ->* . paragraph?)]
[exec (() () #:rest (listof content?) . ->* . element?)]
[commandline (() () #:rest (listof content?) . ->* . paragraph?)]
[menuitem (string? string? . -> . element?)])
(provide (contract-out [PLaneT element?]
[hash-lang (-> element?)]
[etc element?]
[inset-flow (() () #:rest (listof pre-content?) . ->* . nested-flow?)]
[litchar (() () #:rest (listof string?) . ->* . element?)]
[t (() () #:rest (listof pre-content?) . ->* . paragraph?)]
[exec (() () #:rest (listof content?) . ->* . element?)]
[commandline (() () #:rest (listof content?) . ->* . paragraph?)]
[menuitem (string? string? . -> . element?)]))

(define PLaneT (make-element "planetName" '("PLaneT")))

(define etc (make-element #f (list "etc" ._)))

(define (litchar . strs)
(let ([s (string-append* (map (lambda (s) (regexp-replace* "\n" s " "))
strs))])
(cond
[(regexp-match? #rx"^ *$" s) (make-element input-background-color (list (hspace (string-length s))))]
[else
(define ^spaces (car (regexp-match-positions #rx"^ *" s)))
(define $spaces (car (regexp-match-positions #rx" *$" s)))
(make-element
input-background-color
(list (hspace (cdr ^spaces))
(make-element input-color
(list (substring s (cdr ^spaces) (car $spaces))))
(hspace (- (cdr $spaces) (car $spaces)))))])))
(define s (string-append* (map (lambda (s) (regexp-replace* "\n" s " ")) strs)))
(cond
[(regexp-match? #rx"^ *$" s)
(make-element input-background-color (list (hspace (string-length s))))]
[else
(define ^spaces (car (regexp-match-positions #rx"^ *" s)))
(define $spaces (car (regexp-match-positions #rx" *$" s)))
(make-element input-background-color
(list (hspace (cdr ^spaces))
(make-element input-color (list (substring s (cdr ^spaces) (car $spaces))))
(hspace (- (cdr $spaces) (car $spaces)))))]))

(define (onscreen . str)
(make-element 'sf (decode-content str)))
Expand Down Expand Up @@ -173,11 +171,10 @@
(make-blockquote code-inset-style (list b)))

(define (commandline . s)
(make-paragraph (cons (hspace 2) (map (lambda (s)
(if (string? s)
(make-element 'tt (list s))
s))
s))))
(make-paragraph (cons (hspace 2) (for/list ([s (in-list s)])
(if (string? s)
(make-element 'tt (list s))
s)))))

(define (pidefterm . s)
(define c (apply defterm s))
Expand Down
47 changes: 25 additions & 22 deletions scribble-lib/scribble/private/manual-tech.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -9,28 +9,31 @@
"manual-utils.rkt"
"manual-style.rkt")

(provide/contract
[deftech (() (#:normalize? any/c
#:style? any/c
#:key (or/c string? #f)
#:index-extras desc-extras/c)
#:rest (listof pre-content?) . ->* . element?)]
[tech (()
(#:doc (or/c module-path? #f)
#:tag-prefixes (or/c (listof string?) #f)
#:key (or/c string? #f)
#:normalize? any/c
#:indirect? any/c)
#:rest (listof pre-content?)
. ->* . element?)]
[techlink (()
(#:doc (or/c module-path? #f)
#:tag-prefixes (or/c (listof string?) #f)
#:key (or/c string? #f)
#:normalize? any/c
#:indirect? any/c)
#:rest (listof pre-content?)
. ->* . element?)])
(provide (contract-out
[deftech
(()
(#:normalize? any/c #:style? any/c #:key (or/c string? #f) #:index-extras desc-extras/c)
#:rest (listof pre-content?)
. ->* .
element?)]
[tech
(() (#:doc (or/c module-path? #f)
#:tag-prefixes (or/c (listof string?) #f)
#:key (or/c string? #f)
#:normalize? any/c
#:indirect? any/c)
#:rest (listof pre-content?)
. ->* .
element?)]
[techlink
(() (#:doc (or/c module-path? #f)
#:tag-prefixes (or/c (listof string?) #f)
#:key (or/c string? #f)
#:normalize? any/c
#:indirect? any/c)
#:rest (listof pre-content?)
. ->* .
element?)]))

(define (*tech make-elem style doc prefix s key normalize?)
(let* ([c (decode-content s)]
Expand Down
Loading