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

finally got the drscheme:language:object/c contract to render in the documentation properly

Browse Source 
svn: r9797
This commit is contained in:
Robby Findler 2008-05-10 21:15:30 +00:00
parent 5ffab07b47
commit 0752311937
6 changed files with 128 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

150
collects/drscheme/private/language-object-contract.ss
View File

@ -4,71 +4,93 @@
scribble/srcdoc
scheme/class
scheme/gui/base
scheme/contract)
scheme/contract
scribblings/tools/recon)
(require/doc scheme/base scribble/manual)
(require (for-meta 2 scheme/base))
(provide language-object-abstraction)
(define-syntax (language-object-abstraction stx)
(syntax-case stx ()
[(_ id)
(with-syntax ([ctc
#'(object-contract
(config-panel (-> (is-a?/c area-container<%>)
(case-> (-> any/c void?)
(-> any/c))))
(create-executable (-> any/c
(or/c (is-a?/c dialog%) (is-a?/c frame%))
path?
void?))
(default-settings (-> any/c))
(default-settings? (-> any/c boolean?))
(order-manuals (-> (listof bytes?)
(values (listof bytes?) boolean?)))
(front-end/complete-program (-> input-port?
any/c
(-> any/c)))
(front-end/interaction (-> input-port?
any/c
(-> any/c)))
(get-language-name (-> string?))
(get-language-numbers (-> (cons/c number? (listof number?))))
(get-language-position (-> (cons/c string? (listof string?))))
(get-language-url (-> (or/c false/c string?)))
(get-one-line-summary (-> string?))
(get-comment-character (-> (values string? char?)))
(get-style-delta
(-> (or/c false/c
(is-a?/c style-delta%)
(listof
(list/c (is-a?/c style-delta%)
number?
number?)))))
(marshall-settings (-> any/c printable/c))
(on-execute (-> any/c (-> (-> any) any) any))
(render-value (-> any/c
any/c
output-port?
void?))
(render-value/format (-> any/c
any/c
output-port?
(or/c number? (symbols 'infinity))
any))
(unmarshall-settings (-> printable/c any))
(capability-value (-> symbol? any))
#;
(capability-value
(->d ([s (and/c symbol?
drscheme:language:capability-registered?)])
()
[res (drscheme:language:get-capability-contract s)])))])
#'(begin
(define id ctc)
(provide/doc
(thing-doc id
contract?
@{@schemeblock[ctc]}))))]))
(language-object-abstraction drscheme:language:object/c)
[(_ id provide?)
(let-syntax ([save-srcloc
(λ (s)
(define-struct sloc (inside loc) #:prefab)
(syntax-case s ()
[(_ arg)
(with-syntax ([ans
(let loop ([s #'arg])
(cond
[(syntax? s)
(let ([loc (vector (syntax-source s)
(syntax-line s)
(syntax-column s)
(syntax-position s)
(syntax-span s))])
(make-sloc (loop (syntax-e s)) loc))]
[(pair? s) (cons (loop (car s)) (loop (cdr s)))]
[else s]))])
#'ans)]))])
(let* ([ctc
(save-srcloc
(object-contract
(config-panel (-> (is-a?/c area-container<%>)
(case-> (-> any/c void?)
(-> any/c))))
(create-executable (-> any/c
(or/c (is-a?/c dialog%) (is-a?/c frame%))
path?
void?))
(default-settings (-> any/c))
(default-settings? (-> any/c boolean?))
(order-manuals (-> (listof bytes?)
(values (listof bytes?) boolean?)))
(front-end/complete-program (-> input-port?
any/c
(-> any/c)))
(front-end/interaction (-> input-port?
any/c
(-> any/c)))
(get-language-name (-> string?))
(get-language-numbers (-> (cons/c number? (listof number?))))
(get-language-position (-> (cons/c string? (listof string?))))
(get-language-url (-> (or/c false/c string?)))
(get-one-line-summary (-> string?))
(get-comment-character (-> (values string? char?)))
(get-style-delta
(-> (or/c false/c
(is-a?/c style-delta%)
(listof
(list/c (is-a?/c style-delta%)
number?
number?)))))
(marshall-settings (-> any/c printable/c))
(on-execute (-> any/c (-> (-> any) any) any))
(render-value (-> any/c
any/c
output-port?
void?))
(render-value/format (-> any/c
any/c
output-port?
(or/c number? (symbols 'infinity))
any))
(unmarshall-settings (-> printable/c any))
(capability-value
(->d ([s (and/c symbol?
drscheme:language:get-capability-contract)])
()
[res (drscheme:language:capability-registered? s)]))))])
#`(begin
(define id (reconstitute #,ctc provide?))
#,@(if (syntax-e #'provide?)
(list
#`(require/doc "recon.ss")
#`(provide/doc
(thing-doc id
contract?
((reconstitute (schemeblock #,ctc) provide?)))))
'()))))]))

27
collects/drscheme/private/tools.ss
View File

@ -198,16 +198,22 @@
(get-successful-tools))))
;;; ;; ; ; ;;
; ; ; ;
; ; ; ;
; ;;; ;;;; ;;;; ; ;;; ; ;;; ;;; ;;; ;;; ; ;; ;;;
; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ; ; ;
; ; ; ;;;; ; ; ; ; ; ; ; ; ; ; ;; ;;;;;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ; ; ; ; ;;; ; ; ; ; ; ;
;;;;;; ;;; ;;; ; ;;; ; ; ;;;;; ;;; ;; ; ;;; ;; ;; ;;;
;
;
;
;
; ;;;; ;;;; ;; ;; ;;;;
; ;;;; ;;;; ;; ;; ;;;;
; ;;;; ;;;; ;;;;;;; ;;;;;;; ;; ;;;; ;;; ;;; ;;; ;;;; ;;;; ;;; ;;;
; ;;;; ;;;;;; ;;;;;;;; ;;;;;;;; ;;;;;; ;;;;;;;;; ;;; ;;; ;;;;;; ;;;; ;;; ;;;;;
; ;;;; ;;;;;;;; ;;;; ;;;;;;;;; ;;;;;; ;;;; ;;;; ;;;;;; ;;;;;;;; ;;;;;;; ;;;; ;;
; ;;;; ;;;; ;;; ;;;;;;; ;;;; ;;;; ;; ;;;; ;;;; ;;;; ;;;;;; ;;;; ;;; ;;;;;;; ;;;;;;;
; ;;;; ;;;;;;;; ;; ;;;; ;;;;;;;;; ;; ;;;; ;;;; ;;;; ;;;;;; ;;;;;;;; ;;;; ;;; ;;;;;
; ;;;; ;;;;;; ;;;;;;;; ;;;;;;;; ;; ;;;; ;;;; ;;;; ;;;; ;;;;;; ;;;; ;;; ;;;;;;
; ;;;; ;;;; ;; ;;;; ;;;;;;; ;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;; ;;;;
; ;;
;
;
;; load/invoke-tool : installed-tool -> void
@ -315,6 +321,7 @@
;; invokes the tools and returns the two phase thunks.
(define (invoke-tool unit tool-name)
(define-unit-binding unit@ unit (import drscheme:tool^) (export drscheme:tool-exports^))
(language-object-abstraction drscheme:language:object/c #f)
(wrap-tool-inputs
(let ()
(define-values/invoke-unit unit@

3
collects/drscheme/tool-lib.ss
View File

@ -39,8 +39,7 @@ all of the names in the tools library, for use defining keybindings
#'((drscheme:unit:get-program-editor-mixin) a ...)]
[_ #'(drscheme:unit:get-program-editor-mixin)]))
(provide drscheme:language:object/c)
(language-object-abstraction drscheme:language:object/c #t)
(provide/doc

2
collects/scribblings/drscheme/extending.scrbl
View File

@ -104,7 +104,7 @@ For more examples, see the @filepath{htdp} sub-collection in the
@; ----------------------------------------------------------------------
@section{Environment Variables}
@section[#:tag "environment-variables"]{Environment Variables}
Several environment variables can affect DrScheme's behavior:

20
collects/scribblings/tools/recon.ss Normal file
View File

@ -0,0 +1,20 @@
#lang scheme/base
(require (for-syntax scheme/base))
(provide reconstitute)
(begin-for-syntax
(define-struct sloc (inside loc) #:omit-define-syntaxes #:prefab))
(define-syntax (reconstitute orig-stx)
(syntax-case orig-stx ()
[(_ arg src)
(let loop ([stx #'arg])
(cond
[(syntax? stx) (datum->syntax stx (loop (syntax-e stx)))]
[(pair? stx) (cons (loop (car stx)) (loop (cdr stx)))]
[(sloc? stx)
(printf "reconstitute ~s\n" (syntax->datum (sloc-loc stx)))
(datum->syntax #'src
(loop (syntax-e (sloc-inside stx)))
(syntax->datum (sloc-loc stx)))]
[else stx]))]))

12
collects/scribblings/tools/tools.scrbl
View File

@ -16,12 +16,6 @@
@(defmodule drscheme/tool-lib)
@bold{TODO}
@itemize{@item{contract for capability-value method is wrong (commented out version is right, but has circular dependencies)}}
----------------------------------------------------------------------------------------------------
@bold{This Manual}
This manual describes DrScheme's tools interface. It assumes
@ -29,9 +23,9 @@ familiarity with
PLT Scheme, as described in
@(other-manual '(lib "scribblings/guide/guide.scrbl")),
DrScheme, as described in
@(other-manual '(lib "drscheme/drscheme.scrbl")),
@(other-manual '(lib "scribblings/drscheme/drscheme.scrbl")),
and the Framework, as described in
@(other-manual '(lib "framework/framework.scrbl")).
@(other-manual '(lib "scribblings/framework/framework.scrbl")).
@table-of-contents[]
@ -385,7 +379,7 @@ implements that method before overriding it:
]
To help test your tool, use the
@seclink["environment-variables-in-drscheme-manual"]{@tt{PLTONLYTOOL}}
@seclink["environment-variables" #:doc '(lib "scribblings/drscheme/extending.scrbl")]{@tt{PLTONLYTOOL}}
environment variable to load it in isolation.
@section{Creating New Kinds of DrScheme Frames}