commit 83cd2916b3da345c13907b3323f7ee7a24726c69
parent d82317d8719ea1c4056e4cc0abbb0d161a58f629
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 12 Jun 2007 01:44:02 +0000
work on docs for keyword arguments
svn: r6581
original commit: 05607ad6615dfd0bbbb9593d5b620898d373b3b3
Diffstat:
4 files changed, 46 insertions(+), 28 deletions(-)
diff --git a/collects/scribble/basic.ss b/collects/scribble/basic.ss
@@ -96,7 +96,7 @@
(make-element 'subscript (decode-content str)))
(define/kw (superscript #:body str)
- (make-element superscript (decode-content str)))
+ (make-element 'superscript (decode-content str)))
;; ----------------------------------------
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
@@ -92,7 +92,7 @@
(provide onscreen menuitem defterm
schemefont schemevalfont schemeresultfont schemeidfont
- schemeparenfont schemekeywordfont
+ schemeparenfont schemekeywordfont schememetafont
file exec
link procedure
idefterm)
@@ -116,6 +116,8 @@
(make-element "schemesymbol" (decode-content str)))
(define/kw (schemeparenfont #:body str)
(make-element "schemeparen" (decode-content str)))
+ (define/kw (schememetafont #:body str)
+ (make-element "schememeta" (decode-content str)))
(define/kw (schemekeywordfont #:body str)
(make-element "schemekeyword" (decode-content str)))
(define/kw (file #:body str)
@@ -161,9 +163,9 @@
(schemeresultfont "#<undefined>"))
(define dots0
- (make-element "schemeparen" (list "...")))
+ (make-element "schememeta" (list "...")))
(define dots1
- (make-element "schemeparen" (list "..." (superscript "+"))))
+ (make-element "schememeta" (list "...+")))
(define-syntax (arg-contract stx)
(syntax-case stx (... ...+)
@@ -322,7 +324,7 @@
(if (keyword? (car i))
(cadr i)
(car i))))
- (apply append (map cdr prototypes)))])
+ (apply append (map cdr prototypes)))])
(make-splice
(cons
(make-table
@@ -437,21 +439,22 @@
(make-paragraph
(list
(to-element
- `(struct ,(make-target-element*
- (to-element name)
- (let ([name (if (pair? name)
- (car name)
- name)])
- (list* (list name)
- (list name '?)
- (list 'make- name)
- (append
- (map (lambda (f)
- (list name '- (car f)))
- fields)
- (map (lambda (f)
- (list 'set- name '- (car f) '!))
- fields)))))
+ `(,(schemeparenfont "struct")
+ ,(make-target-element*
+ (to-element name)
+ (let ([name (if (pair? name)
+ (car name)
+ name)])
+ (list* (list name)
+ (list name '?)
+ (list 'make- name)
+ (append
+ (map (lambda (f)
+ (list name '- (car f)))
+ fields)
+ (map (lambda (f)
+ (list 'set- name '- (car f) '!))
+ fields)))))
,(map car fields))))))))
(map (lambda (v)
(cond
@@ -506,7 +509,8 @@
[(pair? form) (append (loop (car form))
(loop (cdr form)))]
[else null])))
- forms))])
+ forms))]
+ [current-meta-list '(... ...+)])
(make-splice
(cons
(make-table
@@ -550,7 +554,8 @@
[(pair? form) (append (loop (car form))
(loop (cdr form)))]
[else null]))
- (current-variable-list))])
+ (current-variable-list))]
+ [current-meta-list '(... ...+)])
(make-blockquote
"leftindent"
(cons
diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss
@@ -15,14 +15,16 @@
syntax-ize-hook
current-keyword-list
current-variable-list
+ current-meta-list
(struct shaped-parens (val shape)))
(define no-color "schemeplain")
- (define meta-color "schemeplain")
+ (define reader-color "schemeplain")
(define keyword-color "schemekeyword")
(define comment-color "schemecomment")
(define paren-color "schemeparen")
+ (define meta-color "schememeta")
(define value-color "schemevalue")
(define symbol-color "schemesymbol")
(define variable-color "schemevariable")
@@ -39,6 +41,8 @@
set!)))
(define current-variable-list
(make-parameter null))
+ (define current-meta-list
+ (make-parameter null))
(define defined-names (make-hash-table))
@@ -246,7 +250,7 @@
[(unsyntax) (values "#," 0)])])
(out str (if (positive? (+ quote-depth quote-delta))
value-color
- meta-color))
+ reader-color))
(let ([i (cadr (syntax->list c))])
(set! src-col (or (syntax-column i) src-col))
(hash-table-put! next-col-map src-col dest-col)
@@ -339,8 +343,6 @@
(char=? (string-ref s 0) #\_))
(values (substring s 1) #t #f)
(values s #f #f))))]
- [(is-kw?) (and (identifier? c)
- (memq (syntax-e c) (current-keyword-list)))]
[(is-var?) (and (identifier? c)
(memq (syntax-e c) (current-variable-list)))])
(if (element? (syntax-e c))
@@ -375,8 +377,12 @@
value-color]
[(identifier? c)
(cond
- [is-kw?
+ [(and (identifier? c)
+ (memq (syntax-e c) (current-keyword-list)))
keyword-color]
+ [(and (identifier? c)
+ (memq (syntax-e c) (current-meta-list)))
+ meta-color]
[is-var?
variable-color]
[it? variable-color]
@@ -526,7 +532,9 @@
(list #f 1 col (+ 1 col)
(+ 2
vec-sz
- (sub1 (length l))
+ (if (zero? (length l))
+ 0
+ (sub1 (length l)))
(apply + (map syntax-span l)))))))]
[(pair? v)
(let* ([a (syntax-ize (car v) (+ col 1))]
diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css
@@ -165,6 +165,11 @@
font-family: Courier; font-size: 80%;
}
+ .schememeta {
+ color: #262680;
+ font-family: Courier; font-size: 80%;
+ }
+
.schemeopt {
color: black;
}
