wired in the first line text

svn: r11427

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 ([start 3/10]
-                        (let loop ([i 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]))

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