diff --git a/collects/drscheme/private/first-line-text.ss b/collects/drscheme/private/first-line-text.ss index d7447f272d..ddc6d4653f 100644 --- a/collects/drscheme/private/first-line-text.ss +++ b/collects/drscheme/private/first-line-text.ss @@ -11,6 +11,8 @@ (interface () highlight-first-line)) +(define dark-color (make-object color% 50 0 50)) + (define first-line-text-mixin (mixin ((class->interface text%)) (first-line-text-mixin<%>) (inherit get-text paragraph-end-position get-admin invalidate-bitmap-cache position-location @@ -35,10 +37,12 @@ (define/augment (after-insert start len) (when (<= start end-of-first-line) - (update-first-line))) + (update-first-line)) + (inner (void) after-insert start len)) (define/augment (after-delete start len) (when (<= start end-of-first-line) - (update-first-line))) + (update-first-line)) + (inner (void) after-delete start len)) (define/private (fetch-first-line-height) (let-values ([(_1 h _2 _3) (send (get-dc) get-text-extent first-line (get-font))]) @@ -65,7 +69,9 @@ (unless (equal? fancy-first-line? on?) (set! fancy-first-line? on?) (invalidate-bitmap-cache) - (send (send this get-canvas) refresh))) + (let ([canvas (send this get-canvas)]) + (when canvas + (send canvas refresh))))) (define/override (on-event event) (cond @@ -112,16 +118,19 @@ (send dc draw-line line-left line-height line-right line-height) (when (eq? (send dc get-smoothing) 'aligned) - (send dc set-pen "black" 1 'solid) - (let loop ([i 10]) + (let ([start 3/10] + [end 0] + [steps 10]) + (send dc set-pen dark-color 1 'solid) + (let loop ([i steps]) (unless (zero? i) - (send dc set-alpha (+ 2/5 (* i -1/25))) + (send dc set-alpha (+ start (* (- end start) (/ i steps)))) (send dc draw-line line-left (+ line-height i) line-right (+ line-height i)) - (loop (- i 1)))))) + (loop (- i 1))))))) (send dc set-alpha 1) (send dc set-pen "gray" 1 'transparent) @@ -178,7 +187,21 @@ #; (begin (define f (new frame% [label ""] [width 200] [height 200])) - (define t (new (editor:standard-style-list-mixin (first-line-text-mixin text%)))) + ;(define t (new (editor:standard-style-list-mixin (first-line-text-mixin text%)))) + (define t + (new + (scheme:text-mixin + (text:autocomplete-mixin + (color:text-mixin + (mode:host-text-mixin + (values ; text:delegate-mixin + (text:foreground-color-mixin + (first-line-text-mixin + text:info%))))))))) + (require scheme/runtime-path) + (define-runtime-path here ".") + (send t load-file (build-path (build-path here 'up 'up "framework" "private" "text.ss"))) + #; (send t insert (apply string-append (map (λ (x) (build-string 100 (λ (i) (if (= i 99) #\newline x)))) (string->list "abcdefghijklnopqrstuvwxyz")))) (define c (new editor-canvas% [parent f] [editor t])) diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss index 21a541a575..7aacf84709 100644 --- a/collects/drscheme/private/unit.ss +++ b/collects/drscheme/private/unit.ss @@ -1,4 +1,4 @@ - +#lang scheme/base #| closing: @@ -11,7 +11,6 @@ module browser threading seems wrong. |# -(module unit scheme/base (require scheme/contract scheme/unit scheme/class @@ -429,7 +428,7 @@ module browser threading seems wrong. (define (make-definitions-text%) (let ([definitions-super% ((get-program-editor-mixin) - (values #;first-line-text-mixin + (first-line-text-mixin (drscheme:module-language:module-language-put-file-mixin (scheme:text-mixin (color:text-mixin @@ -441,7 +440,7 @@ module browser threading seems wrong. (λ (x) x) text:info%))))))))))]) (class* definitions-super% (definitions-text<%>) - (inherit get-top-level-window is-locked? lock while-unlocked #;highlight-first-line) + (inherit get-top-level-window is-locked? lock while-unlocked highlight-first-line) (define interactions-text #f) (define/public (set-interactions-text it) @@ -603,12 +602,10 @@ module browser threading seems wrong. (is-a? f -frame<%>)) (send f language-changed))) - #; (highlight-first-line (is-a? (drscheme:language-configuration:language-settings-language _next-settings) drscheme:module-language:module-language<%>)) - (let ([lang (drscheme:language-configuration:language-settings-language next-settings)] [sets (drscheme:language-configuration:language-settings-settings next-settings)]) (preferences:set @@ -786,7 +783,9 @@ module browser threading seems wrong. ;; insert the default-text (queue-callback (lambda () (insert-auto-text))) - + (highlight-first-line + (is-a? (drscheme:language-configuration:language-settings-language next-settings) + drscheme:module-language:module-language<%>)) (inherit set-max-undo-history) (set-max-undo-history 'forever)))) @@ -3957,4 +3956,4 @@ module browser threading seems wrong. (send frame update-toolbar-visibility) (send frame show #t) (set! first-frame? #f) - frame)))) + frame))) \ No newline at end of file