diff --git a/collects/macro-debugger/syntax-browser/image.rkt b/collects/macro-debugger/syntax-browser/image.rkt index 1ecf6f7..bcda3f6 100644 --- a/collects/macro-debugger/syntax-browser/image.rkt +++ b/collects/macro-debugger/syntax-browser/image.rkt @@ -5,7 +5,8 @@ framework "prefs.rkt" "controller.rkt" - "display.rkt") + "display.rkt" + "text.rkt") #| @@ -36,12 +37,10 @@ TODO: tacked arrows ;; print-syntax-columns : (parameter-of (U number 'infinity)) (define print-syntax-columns (make-parameter 40)) -(define standard-text% (text:foreground-color-mixin (editor:standard-style-list-mixin text:basic%))) - ;; print-syntax-to-png : syntax path -> void (define (print-syntax-to-png stx file #:columns [columns (print-syntax-columns)]) - (let ([bmp (print-syntax-to-bitmap stx columns)]) + (let ([bmp (print-syntax-to-bitmap stx #:columns columns)]) (send bmp save-file file 'png)) (void)) @@ -87,7 +86,7 @@ TODO: tacked arrows (send t print #f #f 'postscript #f #f #t))) (define (prepare-editor stx columns) - (define t (new standard-text%)) + (define t (new browser-text%)) (define sl (send t get-style-list)) (send t change-style (send sl find-named-style (editor:get-default-color-style-name))) (print-syntax-to-editor stx t diff --git a/collects/macro-debugger/syntax-browser/text.rkt b/collects/macro-debugger/syntax-browser/text.rkt index 55796a5..334bac4 100644 --- a/collects/macro-debugger/syntax-browser/text.rkt +++ b/collects/macro-debugger/syntax-browser/text.rkt @@ -17,7 +17,8 @@ text:tacking-mixin text:arrows-mixin text:region-data-mixin - text:clickregion-mixin) + text:clickregion-mixin + browser-text%) (define arrow-cursor (make-object cursor% 'arrow)) @@ -410,3 +411,25 @@ Like clickbacks, but: [else (search (cdr idlocs))]))) (super-new))) |# + + +(define browser-text% + (let ([browser-text-default-style-name "widget.rkt::browser-text% basic"]) + (class (text:clickregion-mixin + (text:arrows-mixin + (text:tacking-mixin + (text:hover-drawings-mixin + (text:hover-mixin + (text:region-data-mixin + (text:hide-caret/selection-mixin + (text:foreground-color-mixin + (editor:standard-style-list-mixin text:basic%))))))))) + (inherit set-autowrap-bitmap get-style-list) + (define/override (default-style-name) browser-text-default-style-name) + (super-new (auto-wrap #t)) + (let* ([sl (get-style-list)] + [standard (send sl find-named-style (editor:get-default-color-style-name))] + [browser-basic (send sl find-or-create-style standard + (make-object style-delta% 'change-family 'default))]) + (send sl new-named-style browser-text-default-style-name browser-basic)) + (set-autowrap-bitmap #f)))) diff --git a/collects/macro-debugger/syntax-browser/widget.rkt b/collects/macro-debugger/syntax-browser/widget.rkt index 93783f3..fbae429 100644 --- a/collects/macro-debugger/syntax-browser/widget.rkt +++ b/collects/macro-debugger/syntax-browser/widget.rkt @@ -247,26 +247,3 @@ (send sd set-delta 'change-italic) (send sd set-delta-foreground "red") sd)) - -;; Specialized classes for widget - -(define browser-text% - (let ([browser-text-default-style-name "widget.rkt::browser-text% basic"]) - (class (text:clickregion-mixin - (text:arrows-mixin - (text:tacking-mixin - (text:hover-drawings-mixin - (text:hover-mixin - (text:region-data-mixin - (text:hide-caret/selection-mixin - (text:foreground-color-mixin - (editor:standard-style-list-mixin text:basic%))))))))) - (inherit set-autowrap-bitmap get-style-list) - (define/override (default-style-name) browser-text-default-style-name) - (super-new (auto-wrap #t)) - (let* ([sl (get-style-list)] - [standard (send sl find-named-style (editor:get-default-color-style-name))] - [browser-basic (send sl find-or-create-style standard - (make-object style-delta% 'change-family 'default))]) - (send sl new-named-style browser-text-default-style-name browser-basic)) - (set-autowrap-bitmap #f))))