added support for changing toolbar buttons based on the #lang line (when in the module language) and use that support for #lang scribble/base
svn: r16449
This commit is contained in:
parent
2f47a882c9
commit
be20c0747c
|
@ -4,6 +4,7 @@
|
|||
(provide drscheme:eval^
|
||||
drscheme:debug^
|
||||
drscheme:module-language^
|
||||
drscheme:module-language-tools^
|
||||
drscheme:get-collection^
|
||||
drscheme:main^
|
||||
drscheme:init^
|
||||
|
@ -84,6 +85,16 @@
|
|||
(add-module-language
|
||||
module-language-put-file-mixin))
|
||||
|
||||
(define-signature drscheme:module-langauge-tools-cm^
|
||||
(frame-mixin
|
||||
frame<%>
|
||||
tab-mixin
|
||||
tab<%>
|
||||
definitions-text-mixin
|
||||
definitions-text<%>))
|
||||
(define-signature drscheme:module-language-tools^ extends drscheme:module-langauge-tools-cm^
|
||||
())
|
||||
|
||||
(define-signature drscheme:get-collection-cm^ ())
|
||||
(define-signature drscheme:get-collection^ extends drscheme:get-collection-cm^
|
||||
(get-file/collection))
|
||||
|
|
|
@ -7,7 +7,8 @@
|
|||
[prefix drscheme:frame: drscheme:frame^]
|
||||
[prefix drscheme:rep: drscheme:rep^]
|
||||
[prefix drscheme:debug: drscheme:debug^]
|
||||
[prefix drscheme:tracing: drscheme:tracing^])
|
||||
[prefix drscheme:tracing: drscheme:tracing^]
|
||||
[prefix drscheme:module-language-tools: drscheme:module-language-tools^])
|
||||
(export drscheme:get/extend^)
|
||||
|
||||
(define make-extender
|
||||
|
@ -44,10 +45,11 @@
|
|||
built)))))
|
||||
|
||||
(define (get-base-tab%)
|
||||
(drscheme:tracing:tab-mixin
|
||||
(drscheme:debug:test-coverage-tab-mixin
|
||||
(drscheme:debug:profile-tab-mixin
|
||||
drscheme:unit:tab%))))
|
||||
(drscheme:module-language-tools:tab-mixin
|
||||
(drscheme:tracing:tab-mixin
|
||||
(drscheme:debug:test-coverage-tab-mixin
|
||||
(drscheme:debug:profile-tab-mixin
|
||||
drscheme:unit:tab%)))))
|
||||
|
||||
(define-values (extend-tab get-tab) (make-extender get-base-tab% 'tab%))
|
||||
|
||||
|
@ -64,9 +66,10 @@
|
|||
(make-extender get-base-definitions-canvas% 'definitions-canvas%))
|
||||
|
||||
(define (get-base-unit-frame%)
|
||||
(drscheme:tracing:frame-mixin
|
||||
(drscheme:debug:profile-unit-frame-mixin
|
||||
drscheme:unit:frame%)))
|
||||
(drscheme:module-language-tools:frame-mixin
|
||||
(drscheme:tracing:frame-mixin
|
||||
(drscheme:debug:profile-unit-frame-mixin
|
||||
drscheme:unit:frame%))))
|
||||
|
||||
(define-values (extend-unit-frame get-unit-frame)
|
||||
(make-extender get-base-unit-frame% 'drscheme:unit:frame))
|
||||
|
@ -79,9 +82,10 @@
|
|||
(make-extender get-base-interactions-text% 'interactions-text%))
|
||||
|
||||
(define (get-base-definitions-text%)
|
||||
(drscheme:debug:test-coverage-definitions-text-mixin
|
||||
(drscheme:debug:profile-definitions-text-mixin
|
||||
(drscheme:unit:get-definitions-text%))))
|
||||
(drscheme:module-language-tools:definitions-text-mixin
|
||||
(drscheme:debug:test-coverage-definitions-text-mixin
|
||||
(drscheme:debug:profile-definitions-text-mixin
|
||||
(drscheme:unit:get-definitions-text%)))))
|
||||
|
||||
(define-values (extend-definitions-text get-definitions-text)
|
||||
(make-extender get-base-definitions-text% 'definitions-text%))
|
||||
|
|
|
@ -20,7 +20,8 @@
|
|||
"unit.ss"
|
||||
"tracing.ss"
|
||||
"get-extend.ss"
|
||||
"help-desk.ss")
|
||||
"help-desk.ss"
|
||||
"module-language-tools.ss")
|
||||
|
||||
(provide drscheme@)
|
||||
|
||||
|
@ -39,8 +40,8 @@
|
|||
drscheme:tracing^)
|
||||
(link init@ tools@ modes@ text@ eval@ frame@ rep@ language@
|
||||
module-overview@ unit@ debug@ multi-file-search@ get-extend@
|
||||
language-configuration@ font@ module-language@ help-desk@
|
||||
tracing@ app@
|
||||
language-configuration@ font@ module-language@ module-language-tools@
|
||||
help-desk@ tracing@ app@
|
||||
main@))
|
||||
|
||||
(define-unit/new-import-export drscheme@
|
||||
|
|
223
collects/drscheme/private/module-language-tools.ss
Normal file
223
collects/drscheme/private/module-language-tools.ss
Normal file
|
@ -0,0 +1,223 @@
|
|||
#lang scheme/base
|
||||
(provide module-language-tools@)
|
||||
(require mrlib/switchable-button
|
||||
mrlib/bitmap-label
|
||||
scheme/contract
|
||||
framework
|
||||
scheme/unit
|
||||
scheme/class
|
||||
scheme/gui/base
|
||||
"drsig.ss")
|
||||
|
||||
(define-unit module-language-tools@
|
||||
(import [prefix drscheme:unit: drscheme:unit^]
|
||||
[prefix drscheme:module-language: drscheme:module-language^]
|
||||
[prefix drscheme:language: drscheme:language^]
|
||||
[prefix drscheme:language-configuration: drscheme:language-configuration^])
|
||||
(export drscheme:module-language-tools^)
|
||||
|
||||
(define-local-member-name initialized? move-to-new-language)
|
||||
|
||||
(define tab<%> (interface ()))
|
||||
|
||||
(define tab-mixin
|
||||
(mixin (drscheme:unit:tab<%>) (tab<%>)
|
||||
(inherit get-frame)
|
||||
(define toolbar-buttons '())
|
||||
(define/public (get-lang-toolbar-buttons) toolbar-buttons)
|
||||
(define/public (set-lang-toolbar-buttons bs)
|
||||
(for-each
|
||||
(λ (old-button) (send (get-frame) remove-toolbar-button old-button))
|
||||
toolbar-buttons)
|
||||
(set! toolbar-buttons bs)
|
||||
(send (get-frame) register-toolbar-buttons toolbar-buttons))
|
||||
(super-new)))
|
||||
|
||||
(define frame<%> (interface ()))
|
||||
(define frame-mixin
|
||||
(mixin (drscheme:unit:frame<%>) (frame<%>)
|
||||
(inherit unregister-toolbar-button get-definitions-text)
|
||||
|
||||
(define toolbar-button-panel #f)
|
||||
(define/public (initialized?) (and toolbar-button-panel #t))
|
||||
(define/public (get-toolbar-button-panel) toolbar-button-panel)
|
||||
(define/public (remove-toolbar-button button)
|
||||
(send toolbar-button-panel change-children (λ (l) (remq button l)))
|
||||
(unregister-toolbar-button button))
|
||||
(define/augment (on-tab-change old-tab new-tab)
|
||||
(inner (void) on-tab-change old-tab new-tab)
|
||||
(when toolbar-button-panel
|
||||
(send toolbar-button-panel change-children
|
||||
(λ (l) (send new-tab get-lang-toolbar-buttons)))))
|
||||
(super-new)
|
||||
(inherit get-button-panel)
|
||||
(set! toolbar-button-panel (new horizontal-panel%
|
||||
[parent (get-button-panel)]
|
||||
[stretchable-width #f]))
|
||||
;; move button panel to the front of the list
|
||||
(send (get-button-panel) change-children
|
||||
(λ (l) (cons toolbar-button-panel (remq toolbar-button-panel l))))
|
||||
(send (get-definitions-text) move-to-new-language)))
|
||||
|
||||
(define definitions-text<%> (interface ()))
|
||||
(define definitions-text-mixin
|
||||
(mixin (text:basic<%> drscheme:unit:definitions-text<%>) (definitions-text<%>)
|
||||
(inherit get-next-settings)
|
||||
(define in-module-language? #f) ;; true when we are in the module language
|
||||
(define hash-lang-last-location #f) ;; non-false when we know where the hash-lang line ended
|
||||
(define hash-lang-language #f) ;; non-false is the string that was parsed for the language
|
||||
(define/augment (after-insert start len)
|
||||
(inner (void) after-insert start len)
|
||||
(modification-at start))
|
||||
(define/augment (after-delete start len)
|
||||
(inner (void) after-delete start len)
|
||||
(modification-at start))
|
||||
(define/private (modification-at start)
|
||||
(when (send (send (get-tab) get-frame) initialized?)
|
||||
(when in-module-language?
|
||||
(when (or (not hash-lang-last-location)
|
||||
(<= start hash-lang-last-location))
|
||||
(move-to-new-language)))))
|
||||
|
||||
(define/private (update-in-module-language? new-one)
|
||||
(unless (equal? new-one in-module-language?)
|
||||
(set! in-module-language? new-one)
|
||||
(cond
|
||||
[in-module-language?
|
||||
(move-to-new-language)]
|
||||
[else
|
||||
(clear-things-out)])))
|
||||
|
||||
(define/public (move-to-new-language)
|
||||
(let* ([port (open-input-text-editor this)]
|
||||
[info-result (with-handlers ((exn:fail? (λ (x) #f)))
|
||||
(read-language port (λ () #f)))])
|
||||
(let-values ([(line col pos) (port-next-location port)])
|
||||
(unless (equal? (get-text 0 pos) hash-lang-language)
|
||||
(set! hash-lang-language (get-text 0 pos))
|
||||
(set! hash-lang-last-location pos)
|
||||
(clear-things-out)
|
||||
(when info-result
|
||||
(register-new-buttons
|
||||
(contract (or/c #f (listof (list/c string?
|
||||
(is-a?/c bitmap%)
|
||||
(-> (is-a?/c drscheme:unit:frame<%>) any))))
|
||||
(info-result 'drscheme:toolbar-buttons)
|
||||
(get-lang-name pos)
|
||||
'drscheme/private/module-language-tools)))))))
|
||||
|
||||
(inherit get-tab)
|
||||
(define/private (register-new-buttons buttons)
|
||||
(when buttons
|
||||
(let* ([tab (get-tab)]
|
||||
[frame (send tab get-frame)])
|
||||
(send tab set-lang-toolbar-buttons
|
||||
(map (λ (button-spec)
|
||||
(new switchable-button%
|
||||
[label (list-ref button-spec 0)]
|
||||
[bitmap (list-ref button-spec 1)]
|
||||
[parent (send frame get-toolbar-button-panel)]
|
||||
[callback
|
||||
(lambda (button)
|
||||
((list-ref button-spec 2) frame))]))
|
||||
buttons)))))
|
||||
|
||||
(inherit get-text)
|
||||
(define/private (get-lang-name pos)
|
||||
(cond
|
||||
[(zero? pos) '<<unknown>>]
|
||||
[else
|
||||
(let ([str (get-text 0 pos)])
|
||||
(if (char-whitespace? (string-ref str (- (string-length str) 1)))
|
||||
(substring str 0 (- (string-length str) 1))
|
||||
str))]))
|
||||
|
||||
;; removes language-specific customizations
|
||||
(define/private (clear-things-out)
|
||||
(send (get-tab) set-lang-toolbar-buttons '()))
|
||||
|
||||
(define/augment (after-set-next-settings settings)
|
||||
(update-in-module-language?
|
||||
(is-a? (drscheme:language-configuration:language-settings-language settings)
|
||||
drscheme:module-language:module-language<%>))
|
||||
(inner (void) after-set-next-settings settings))
|
||||
(super-new)
|
||||
(set! in-module-language?
|
||||
(is-a? (drscheme:language-configuration:language-settings-language (get-next-settings))
|
||||
drscheme:module-language:module-language<%>)))))
|
||||
|
||||
|
||||
|
||||
#|
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#lang scheme/gui
|
||||
|
||||
(require mrlib/switchable-button
|
||||
mrlib/bitmap-label
|
||||
drscheme/tool
|
||||
scheme/system
|
||||
setup/xref)
|
||||
|
||||
(provide tool@)
|
||||
|
||||
(define-namespace-anchor anchor)
|
||||
|
||||
(define scribble-bm (make-object bitmap% 1 1))
|
||||
|
||||
(define tool@
|
||||
(unit
|
||||
(import drscheme:tool^)
|
||||
(export drscheme:tool-exports^)
|
||||
|
||||
(define phase1 void)
|
||||
(define phase2 void)
|
||||
|
||||
(define (make-new-unit-frame% super%)
|
||||
(class super%
|
||||
(inherit get-button-panel
|
||||
get-definitions-text)
|
||||
(super-instantiate ())
|
||||
|
||||
(define client-panel
|
||||
(new horizontal-pane% (parent (get-button-panel))))
|
||||
|
||||
(define (make-render-button label mode suffix extra-cmdline)
|
||||
(new switchable-button%
|
||||
[label label]
|
||||
[bitmap scribble-bm]
|
||||
[parent client-panel]
|
||||
[callback
|
||||
(lambda (button)
|
||||
(let* ([t (get-definitions-text)]
|
||||
[fn (send t get-filename)])
|
||||
(if fn
|
||||
(begin
|
||||
(send t save-file)
|
||||
(parameterize ([current-namespace (make-base-namespace)]
|
||||
[current-command-line-arguments
|
||||
(list->vector
|
||||
(append
|
||||
extra-cmdline
|
||||
(list mode (if (path? fn) (path->string fn) fn))))])
|
||||
(namespace-attach-module (namespace-anchor->empty-namespace anchor) 'setup/xref)
|
||||
(dynamic-require 'scribble/run #f)
|
||||
(let-values ([(base name dir?) (split-path fn)])
|
||||
(system (format "open ~a" (path-replace-suffix name suffix))))))
|
||||
(message-box "Not Named" "Cannot render unsaved file"))))]))
|
||||
|
||||
(inherit register-toolbar-button)
|
||||
(define pdf-button (make-render-button "PDF" "--pdf" #".pdf" null))
|
||||
(register-toolbar-button pdf-button)
|
||||
(define html-button (make-render-button "HTML" "--html" #".html" '("++xref-in" "setup/xref" "load-collections-xref")))
|
||||
(register-toolbar-button html-button)
|
||||
|
||||
(send (get-button-panel) change-children
|
||||
(lambda (l) (cons client-panel (remq client-panel l))))))
|
||||
|
||||
(drscheme:get/extend:extend-unit-frame make-new-unit-frame% #f)))
|
||||
|
||||
|#
|
|
@ -62,6 +62,7 @@ module browser threading seems wrong.
|
|||
[prefix drscheme:eval: drscheme:eval^]
|
||||
[prefix drscheme:init: drscheme:init^]
|
||||
[prefix drscheme:module-language: drscheme:module-language^]
|
||||
[prefix drscheme:module-language-tools: drscheme:module-language-tools^]
|
||||
[prefix drscheme:modes: drscheme:modes^]
|
||||
[prefix drscheme:debug: drscheme:debug^])
|
||||
(export (rename drscheme:unit^
|
||||
|
@ -1399,6 +1400,8 @@ module browser threading seems wrong.
|
|||
|
||||
get-language-menu
|
||||
register-toolbar-button
|
||||
register-toolbar-buttons
|
||||
unregister-toolbar-button
|
||||
get-tabs))
|
||||
|
||||
|
||||
|
@ -1868,19 +1871,23 @@ module browser threading seems wrong.
|
|||
(and (not (toolbar-is-hidden?))
|
||||
(eq? (cdr (preferences:get 'drscheme:toolbar-state))
|
||||
'left)))
|
||||
|
||||
|
||||
(define/private (orient/show bar-at-beginning?)
|
||||
(let ([vertical? (or (toolbar-is-left?) (toolbar-is-right?))])
|
||||
(begin-container-sequence)
|
||||
(show-info)
|
||||
|
||||
(let ([bpo (send button-panel get-orientation)])
|
||||
(unless (equal? bpo (not vertical?))
|
||||
(send button-panel set-orientation (not vertical?))
|
||||
|
||||
;; have to be careful to avoid reversing the list when the orientation is already proper
|
||||
(send button-panel change-children reverse)))
|
||||
|
||||
;; orient the button panel and all panels inside it.
|
||||
(let loop ([obj button-panel])
|
||||
(when (is-a? obj area-container<%>)
|
||||
(when (or (is-a? obj vertical-panel%)
|
||||
(is-a? obj horizontal-panel%))
|
||||
(unless (equal? (send obj get-orientation) (not vertical?))
|
||||
(send obj set-orientation (not vertical?))
|
||||
;; have to be careful to avoid reversing the list when the orientation is already proper
|
||||
(send obj change-children reverse)))
|
||||
(for-each loop (send obj get-children))))
|
||||
|
||||
(orient)
|
||||
|
||||
(send top-outer-panel stretchable-height vertical?)
|
||||
|
@ -1904,6 +1911,14 @@ module browser threading seems wrong.
|
|||
(set! toolbar-buttons (cons b toolbar-buttons))
|
||||
(orient))
|
||||
|
||||
(define/public (register-toolbar-buttons bs)
|
||||
(set! toolbar-buttons (append bs toolbar-buttons))
|
||||
(orient))
|
||||
|
||||
(define/public (unregister-toolbar-button b)
|
||||
(set! toolbar-buttons (remq b toolbar-buttons))
|
||||
(void))
|
||||
|
||||
(define/private (orient)
|
||||
(let ([vertical? (or (toolbar-is-left?) (toolbar-is-right?))])
|
||||
(for-each
|
||||
|
|
|
@ -10,6 +10,9 @@ scribble/base/lang
|
|||
(case key
|
||||
[(color-lexer)
|
||||
(dynamic-require 'syntax-color/scribble-lexer 'scribble-inside-lexer)]
|
||||
[(drscheme:toolbar-buttons)
|
||||
(dynamic-require 'scribble/drscheme-buttons 'drscheme-buttons)]
|
||||
[else (default key)]))
|
||||
|
||||
(require (prefix-in scribble: "../../reader.ss"))
|
||||
|
||||
|
|
50
collects/scribble/drscheme-buttons.ss
Normal file
50
collects/scribble/drscheme-buttons.ss
Normal file
|
@ -0,0 +1,50 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require scheme/runtime-path
|
||||
scheme/gui/base
|
||||
scheme/class
|
||||
mrlib/bitmap-label
|
||||
scheme/system
|
||||
setup/xref)
|
||||
|
||||
(provide drscheme-buttons)
|
||||
|
||||
(define-runtime-path pdf-png-path "pdf.png")
|
||||
(define-runtime-path html-png-path "html.png")
|
||||
(define pdf.png (make-object bitmap% pdf-png-path 'png/mask))
|
||||
(define html.png (make-object bitmap% html-png-path 'png/mask))
|
||||
|
||||
(define-namespace-anchor anchor)
|
||||
|
||||
(define (make-render-button label bmp mode suffix extra-cmdline)
|
||||
(list
|
||||
label
|
||||
bmp
|
||||
(λ (drs-frame)
|
||||
(let* ([t (send drs-frame get-definitions-text)]
|
||||
[fn (send t get-filename)])
|
||||
(if (and fn (not (send t is-modified?)))
|
||||
(let ([p (open-output-string)])
|
||||
(parameterize ([current-namespace (make-base-namespace)]
|
||||
[current-output-port p]
|
||||
[current-error-port p]
|
||||
[current-command-line-arguments
|
||||
(list->vector
|
||||
(append
|
||||
extra-cmdline
|
||||
(list mode (if (path? fn) (path->string fn) fn))))])
|
||||
(namespace-attach-module (namespace-anchor->empty-namespace anchor) 'setup/xref)
|
||||
(dynamic-require 'scribble/run #f)
|
||||
(let-values ([(base name dir?) (split-path fn)])
|
||||
(system (format "open ~a" (path-replace-suffix name suffix)))))
|
||||
(message-box "Scribble" (get-output-string p) drs-frame))
|
||||
(message-box "Not Named" "Cannot render unsaved file"))))))
|
||||
|
||||
(define drscheme-buttons
|
||||
(case (system-type)
|
||||
[(macosx)
|
||||
;; really this is only to guard the "open" system call above.
|
||||
(list (make-render-button "PDF" pdf.png "--pdf" #".pdf" null)
|
||||
(make-render-button "HTML" html.png "--html" #".html" '("++xref-in" "setup/xref" "load-collections-xref")))]
|
||||
[else
|
||||
'()]))
|
BIN
collects/scribble/html.png
Normal file
BIN
collects/scribble/html.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 908 B |
BIN
collects/scribble/pdf.png
Normal file
BIN
collects/scribble/pdf.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 858 B |
69
collects/scribble/private/mk-drs-bitmaps.ss
Normal file
69
collects/scribble/private/mk-drs-bitmaps.ss
Normal file
|
@ -0,0 +1,69 @@
|
|||
#lang scheme/gui
|
||||
|
||||
(define width 16)
|
||||
(define height 16)
|
||||
|
||||
(define (draw1 dc color?) (draw dc "pdf" 0 7 color?))
|
||||
(define (draw2 dc color?) (draw dc "htm" -1 5 color?))
|
||||
|
||||
(define (draw dc str dx dy color?)
|
||||
(send dc clear)
|
||||
(send dc set-font (send the-font-list find-or-create-font 15 " Futura" 'swiss 'normal 'bold))
|
||||
(let-values ([(tw th _1 _2) (send dc get-text-extent "@")])
|
||||
(when color? (send dc set-text-foreground (send the-color-database find-color "gray")))
|
||||
(send dc draw-text "@"
|
||||
(- (/ width 2) (/ tw 2))
|
||||
(- (/ height 2) (/ th 2)))
|
||||
(send dc set-font (send the-font-list find-or-create-font 6 " Gill Sans" 'swiss 'normal 'bold))
|
||||
(when color? (send dc set-text-foreground (send the-color-database find-color "purple")))
|
||||
(send dc draw-text str (+ 0 dx) (- height dy) #f 0 (* pi 1/4))))
|
||||
|
||||
(define f (new frame% [label ""] [width 100] [height 100] [alignment '(center center)]))
|
||||
(define c (new canvas%
|
||||
[parent f]
|
||||
[stretchable-width #f]
|
||||
[stretchable-height #f]
|
||||
[paint-callback (λ (c dc) (draw-bm dc pdf-bitmap))]
|
||||
[min-width 16]
|
||||
[min-height 16]))
|
||||
(define c2 (new canvas%
|
||||
[parent f]
|
||||
[stretchable-width #f]
|
||||
[stretchable-height #f]
|
||||
[paint-callback (λ (c dc) (draw-bm dc html-bitmap))]
|
||||
[min-width 16]
|
||||
[min-height 16]))
|
||||
|
||||
|
||||
(define (mk-bitmap draw)
|
||||
(define mask-bm (make-object bitmap% width height))
|
||||
(define bm (make-object bitmap% width height))
|
||||
(define bdc (make-object bitmap-dc%))
|
||||
(send bm set-loaded-mask mask-bm)
|
||||
(send bdc set-bitmap mask-bm)
|
||||
(draw bdc #f)
|
||||
(send bdc set-bitmap bm)
|
||||
(draw bdc #t)
|
||||
(send bdc set-bitmap #f)
|
||||
bm)
|
||||
|
||||
(define (draw-bm dc bm)
|
||||
#;(send dc draw-bitmap (send bm get-loaded-mask) 0 0)
|
||||
|
||||
(send dc set-pen "lightgray" 1 'transparent)
|
||||
(send dc set-brush "lightgray" 'solid)
|
||||
(send dc draw-rectangle 0 0 width height)
|
||||
(send dc draw-bitmap bm 0 0
|
||||
'solid
|
||||
(send the-color-database find-color "black")
|
||||
(send bm get-loaded-mask)))
|
||||
|
||||
|
||||
(define pdf-bitmap (mk-bitmap draw1))
|
||||
(define html-bitmap (mk-bitmap draw2))
|
||||
|
||||
(begin
|
||||
(send pdf-bitmap save-file "../pdf.png" 'png)
|
||||
(send html-bitmap save-file "../html.png" 'png))
|
||||
|
||||
(send f show #t)
|
|
@ -1,6 +1,7 @@
|
|||
#lang scribble/doc
|
||||
@(begin
|
||||
(require scribble/manual
|
||||
(for-label scheme/gui/base)
|
||||
(for-label drscheme/tool-lib)
|
||||
(for-label scheme/unit)
|
||||
(for-label scheme/base)
|
||||
|
@ -40,7 +41,6 @@ Cormac Flanagan,
|
|||
Matthew Flatt,
|
||||
Max Hailperin,
|
||||
Philippe Meunier,
|
||||
and
|
||||
Christian Queinnec,
|
||||
PLT at large, and many others for
|
||||
their feedback and help.
|
||||
|
@ -52,14 +52,9 @@ functionality. To extend the appearance
|
|||
or the functionality the DrScheme window (say, to annotate
|
||||
programs in certain ways, to add buttons to the DrScheme
|
||||
frame or to add additional languages to DrScheme) use a
|
||||
tool. The Static Debugger, the Syntax Checker, the Stepper,
|
||||
tool. The Macro Stepper, the Syntax Checker, the Stepper,
|
||||
and the teaching languages are all implemented as tools.
|
||||
|
||||
Libraries are for extensions of DrScheme that only want to
|
||||
add new functions and other values bound in the users
|
||||
namespace. See the DrScheme manual for more information on
|
||||
constructing libraries.
|
||||
|
||||
When DrScheme starts up, it looks for tools by reading
|
||||
fields in the @File{info.ss} file of each collection and the
|
||||
newest version of each PLaneT package installed on the
|
||||
|
@ -467,6 +462,23 @@ file based on the file's extension. If the file ends with
|
|||
@File{.txt}, DrScheme uses text mode. Otherwise, DrScheme
|
||||
uses Scheme mode.
|
||||
|
||||
@section{@tt{#lang}-specific tools}
|
||||
@section-index["drscheme:toolbar-buttons"]
|
||||
|
||||
If the result of @scheme[read-language] for a language is a function,
|
||||
DrScheme will query it to determine if there are any new toolbar
|
||||
buttons to be used when editing files in this language (when
|
||||
DrScheme's language is set to the Module language).
|
||||
|
||||
Specifically, DrScheme will pass @scheme['drscheme:toolbar-buttons]
|
||||
to the function and expect back a value matching this contract:
|
||||
@schemeblock[(listof (list/c string?
|
||||
(is-a?/c bitmap%)
|
||||
(-> (is-a?/c drscheme:unit:frame<%>) any)))]
|
||||
which is then used to create new toolbar buttons, one for each list in the
|
||||
first. The string is the label on the button; the bitmap is the icon (it should be 16x16),
|
||||
and the function is called when the button is clicked.
|
||||
|
||||
@section{Language-specific capabilities}
|
||||
|
||||
Drscheme's capability interface provides a mechanism for
|
||||
|
|
|
@ -684,6 +684,18 @@ Registers the toolbar button @scheme[tb]. This is required
|
|||
so that the toolbar buttons properly switch orientation when
|
||||
the toolbar's position is moved.
|
||||
}
|
||||
|
||||
@defmethod[(register-toolbar-buttons [tbs (listof (is-a?/c switchable-button%))]) void?]{
|
||||
Simultaneously registers the toolbar buttons @scheme[tbs]. This is required
|
||||
so that the toolbar buttons properly switch orientation when
|
||||
the toolbar's position is moved.
|
||||
}
|
||||
|
||||
@defmethod[(unregister-toolbar-button [tb (is-a?/c switchable-button%)]) void?]{
|
||||
Unregisters the toolbar button @scheme[tb]. Use this method to ensure
|
||||
that the button is not referenced by this frame and thus can be gc'd.
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user