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

add big "definitions" and "interactions" labels to the drracket

Browse Source 
definitions and interactions windows
This commit is contained in:
Robby Findler 2012-07-25 08:58:43 -05:00
parent cdee10e2c0
commit 7b72ddb7bf
5 changed files with 99 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/drracket/private/drsig.rkt
View File

@ -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^

16
collects/drracket/private/get-extend.rkt
View File

@ -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%))

5
collects/drracket/private/main.rkt
View File

@ -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%

77
collects/drracket/private/module-language.rkt
View File

@ -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

6
collects/string-constants/private/english-string-constants.rkt
View File

@ -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
)