diff --git a/collects/drracket/private/drsig.rkt b/collects/drracket/private/drsig.rkt index f535cfc282..c9228eff0f 100644 --- a/collects/drracket/private/drsig.rkt +++ b/collects/drracket/private/drsig.rkt @@ -97,6 +97,8 @@ (module-language-online-expand-text-mixin module-language-online-expand-frame-mixin module-language-online-expand-tab-mixin + module-language-interactions-text-mixin + module-language-definitions-text-mixin initialize-prefs-panel)) (define-signature drracket:module-language-tools-cm^ diff --git a/collects/drracket/private/get-extend.rkt b/collects/drracket/private/get-extend.rkt index 28818eefff..154e54b299 100644 --- a/collects/drracket/private/get-extend.rkt +++ b/collects/drracket/private/get-extend.rkt @@ -77,18 +77,20 @@ (make-extender get-base-unit-frame% 'drracket:unit:frame)) (define (get-base-interactions-text%) - (drracket:debug:test-coverage-interactions-text-mixin - drracket:rep:text%)) + (drracket:module-language:module-language-interactions-text-mixin + (drracket:debug:test-coverage-interactions-text-mixin + drracket:rep:text%))) (define-values (extend-interactions-text get-interactions-text) (make-extender get-base-interactions-text% 'interactions-text%)) (define (get-base-definitions-text%) - (drracket:module-language:module-language-online-expand-text-mixin - (drracket:module-language-tools:definitions-text-mixin - (drracket:debug:test-coverage-definitions-text-mixin - (drracket:debug:profile-definitions-text-mixin - (drracket:unit:get-definitions-text%)))))) + (drracket:module-language:module-language-definitions-text-mixin + (drracket:module-language:module-language-online-expand-text-mixin + (drracket:module-language-tools:definitions-text-mixin + (drracket:debug:test-coverage-definitions-text-mixin + (drracket:debug:profile-definitions-text-mixin + (drracket:unit:get-definitions-text%))))))) (define-values (extend-definitions-text get-definitions-text) (make-extender get-base-definitions-text% 'definitions-text%)) diff --git a/collects/drracket/private/main.rkt b/collects/drracket/private/main.rkt index a658de8cd8..9e3d2427d3 100644 --- a/collects/drracket/private/main.rkt +++ b/collects/drracket/private/main.rkt @@ -69,6 +69,7 @@ (cons/c (list/c 'main) (cons/c (list/c 'test) (listof (listof symbol?))))) +(preferences:set-default 'drracket:defs/ints-labels #t boolean?) (drr:set-default 'drracket:language-dialog:hierlist-default #f (λ (x) (or (not x) (and (list? x) (andmap string? x))))) @@ -312,6 +313,10 @@ (string-constant show-line-numbers) editor-panel) + (make-check-box 'drracket:defs/ints-labels + (string-constant show-defs/ints-label) + editor-panel) + ;; come back to this one. #; (letrec ([hp (new horizontal-panel% diff --git a/collects/drracket/private/module-language.rkt b/collects/drracket/private/module-language.rkt index fa9f054514..211c5f7a0d 100644 --- a/collects/drracket/private/module-language.rkt +++ b/collects/drracket/private/module-language.rkt @@ -1751,6 +1751,83 @@ (super-new))) + (define defs/ints-font + (send the-font-list find-or-create-font 72 'swiss 'normal 'normal)) + + (define (mk-module-language-text-mixin id) + (mixin (editor<%>) () + (inherit get-admin invalidate-bitmap-cache get-dc + dc-location-to-editor-location) + (define inside? #f) + (define/override (on-event evt) + (define new-inside? + (cond + [(send evt leaving?) #f] + [else (preferences:get 'drracket:defs/ints-labels)])) + (unless (equal? new-inside? inside?) + (set! inside? new-inside?) + (invalidate-bitmap-cache 0 0 'display-end 'display-end)) + (cond + [(and (preferences:get 'drracket:defs/ints-labels) + (send evt button-down?) + (get-admin)) + (define admin (get-admin)) + (define dc (get-dc)) + (define-values (tw th _1 _2) (send dc get-text-extent id defs/ints-font)) + (define-values (mx my) (dc-location-to-editor-location + (send evt get-x) (send evt get-y))) + (send admin get-view bx by bw bh) + (cond + [(and (<= (- (unbox bw) tw) mx (unbox bw)) + (<= (- (unbox bh) th) my (unbox bh))) + (define menu (new popup-menu%)) + (new menu-item% + [label (string-constant hide-defs/ints-label)] + [parent menu] + [callback (λ (x y) + (preferences:set 'drracket:defs/ints-labels #f))]) + (send admin popup-menu menu (+ (send evt get-x) 1) (+ (send evt get-y) 1))] + [else + (super on-event evt)])] + [else (super on-event evt)])) + + (define/override (on-paint before? dc left top right bottom dx dy draw-caret) + (super on-paint before? dc left top right bottom dx dy draw-caret) + (unless before? + (when inside? + (define admin (get-admin)) + (when admin + (send admin get-view bx by bw bh) + (define α (send dc get-alpha)) + (define fore (send dc get-text-foreground)) + (send dc set-font defs/ints-font) + (define-values (tw th _1 _2) (send dc get-text-extent id)) + (define tx (- (unbox bw) tw)) + (define ty (- (unbox bh) th)) + (when (and (or (< left tx right) + (< left (+ tx tw) right)) + (or (< top ty bottom) + (< top (+ ty th) bottom))) + (send dc set-text-foreground "black") + (send dc set-alpha .5) + (send dc draw-text id (+ dx tx) (+ dy ty)) + (send dc set-alpha α) + (send dc set-text-foreground fore)) + (send dc set-font defs/ints-font))))) + (super-new))) + + + (define bx (box 0)) + (define by (box 0)) + (define bw (box 0)) + (define bh (box 0)) + + + (define module-language-interactions-text-mixin + (mk-module-language-text-mixin (string-constant interactions-window-label))) + (define module-language-definitions-text-mixin + (mk-module-language-text-mixin (string-constant definitions-window-label))) + (define module-language-compile-lock (make-compile-lock)) (define module-language-parallel-lock-client diff --git a/collects/string-constants/private/english-string-constants.rkt b/collects/string-constants/private/english-string-constants.rkt index 9ed37dc177..239c8122de 100644 --- a/collects/string-constants/private/english-string-constants.rkt +++ b/collects/string-constants/private/english-string-constants.rkt @@ -1661,5 +1661,11 @@ please adhere to these guidelines: ;; optimization coach (hide-optimization-coach "Hide Optimization Coach") (show-optimization-coach "Show Optimization Coach") + + ;; labels used (in a big font) in the background of the definitions and interactions windows + (definitions-window-label "definitions") + (interactions-window-label "interactions") + (hide-defs/ints-label "Hide Definitions/Interactions Labels") ;; popup menu + (show-defs/ints-label "Show definitions/interactions labels") ;; preferences checkbox )