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

wired in the first line text

Browse Source 
svn: r11427
This commit is contained in:
Robby Findler 2008-08-25 19:46:41 +00:00
parent 3e0f3c47e1
commit 354ebabe0c
2 changed files with 38 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/drscheme/private/first-line-text.ss
View File

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

15
collects/drscheme/private/unit.ss
View File

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