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

adjusted input box so that it appears after output (if any), cleaned up scrolling when output is generated and an input box is visible, changed EOF snip to show an arrow cursor

Browse Source 
svn: r1408

original commit: ea3b0c87819db9b2160d412ecf9eaf2803b132f6
This commit is contained in:
Matthew Flatt 2005-11-25 16:08:58 +00:00
parent 577affdd5f
commit 62204510d1
1 changed files with 46 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
collects/framework/private/text.ss
View File

@ -918,6 +918,8 @@ WARNING: printf is rebound in the body of the unit to always
(define (set-box/f! b v) (when (box? b) (set-box! b v))) (define (set-box/f! b v) (when (box? b) (set-box! b v)))
(define arrow-cursor (make-object cursor% 'arrow))
(define eof-snip% (define eof-snip%
(class image-snip% (class image-snip%
(init-field port-text) (init-field port-text)
@ -928,9 +930,11 @@ WARNING: printf is rebound in the body of the unit to always
(define/override (on-event dc x y editorx editory event) (define/override (on-event dc x y editorx editory event)
(when (send event button-up? 'left) (when (send event button-up? 'left)
(send port-text send-eof-to-box-in-port))) (send port-text send-eof-to-box-in-port)))
(define/override (adjust-cursor dc x y edx edy e)
arrow-cursor)
(super-make-object (icon:get-eof-bitmap)) (super-make-object (icon:get-eof-bitmap))
(inherit set-flags get-flags) (inherit set-flags get-flags)
(set-flags (list* 'handles-events 'hard-newline (get-flags))))) (set-flags (list* 'handles-events (get-flags)))))
(define ports-mixin (define ports-mixin
(mixin (wide-snip<%>) (ports<%>) (mixin (wide-snip<%>) (ports<%>)
@ -952,7 +956,11 @@ WARNING: printf is rebound in the body of the unit to always
position-paragraph position-paragraph
release-snip release-snip
set-caret-owner set-caret-owner
split-snip) split-snip
get-focus-snip
get-view-size
scroll-to-position
position-location)
;; private field ;; private field
(define eventspace (current-eventspace)) (define eventspace (current-eventspace))
@ -1145,27 +1153,48 @@ WARNING: printf is rebound in the body of the unit to always
(lock l?)) (lock l?))
(set! box-input #f))) (set! box-input #f)))
(define/private (adjust-box-input-width)
(when box-input
(let ([w (box 0)]
[x (box 0)]
[bw (send (icon:get-eof-bitmap) get-width)])
(get-view-size w #f)
(let ([pos (- (last-position) 2)])
(position-location pos x #f #t
(not (= pos (paragraph-start-position (position-paragraph pos))))))
(let ([size (- (unbox w) (unbox x) bw 24)])
(when (positive? size)
(send box-input set-min-width size))))))
(define/augment (on-display-size)
(adjust-box-input-width)
(inner (void) on-display-size))
(define/private (on-box-peek) (define/private (on-box-peek)
(unless box-input (unless box-input
(let* ([ed (new (get-box-input-text%))] (let* ([ed (new (get-box-input-text%))]
[es (new (get-box-input-editor-snip%) [es (new (get-box-input-editor-snip%)
(editor ed))] (editor ed))]
[locked? (is-locked?)]) [locked? (is-locked?)])
(begin-edit-sequence)
(send ed set-port-text this) (send ed set-port-text this)
(lock #f) (lock #f)
(unless (= unread-start-point (paragraph-start-position (position-paragraph unread-start-point))) #;(unless (= unread-start-point (paragraph-start-position (position-paragraph unread-start-point)))
(insert-between "\n")) (insert-between "\n"))
(insert-between es) (insert-between es)
(insert-between eof-button) (insert-between eof-button)
(send (get-canvas) add-wide-snip es) #;(send (get-canvas) add-wide-snip es)
(set! box-input es) (set! box-input es)
(adjust-box-input-width)
(set-caret-owner es 'display) (set-caret-owner es 'display)
(lock locked?)))) (lock locked?)
(end-edit-sequence))))
(define/public (new-box-input ed) (define/public (new-box-input ed)
(when (eq? ed (send box-input get-editor)) ;; just in case things get out of sync. (when (eq? ed (send box-input get-editor)) ;; just in case things get out of sync.
(let ([locked? (is-locked?)]) (let ([locked? (is-locked?)])
(begin-edit-sequence) (begin-edit-sequence)
(send box-input set-min-width 'none)
(lock #f) (lock #f)
(let ([old-insertion-point insertion-point]) (let ([old-insertion-point insertion-point])
@ -1178,7 +1207,8 @@ WARNING: printf is rebound in the body of the unit to always
[(is-a? snip string-snip%) [(is-a? snip string-snip%)
(send snip get-text 0 (send snip get-count))] (send snip get-text 0 (send snip get-count))]
[else snip]) [else snip])
(make-object style-delta%)))) (make-object style-delta%)))
#t)
(loop next)))) (loop next))))
;; this is copied code ... ;; this is copied code ...
@ -1194,6 +1224,7 @@ WARNING: printf is rebound in the body of the unit to always
(bytes->list (string->bytes/utf-8 (string s/c))))])))) (bytes->list (string->bytes/utf-8 (string s/c))))]))))
(lock locked?) (lock locked?)
(adjust-box-input-width)
(end-edit-sequence)))) (end-edit-sequence))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1225,12 +1256,12 @@ WARNING: printf is rebound in the body of the unit to always
(parameterize ([current-eventspace eventspace]) (parameterize ([current-eventspace eventspace])
(queue-callback (queue-callback
(λ () (λ ()
(do-insertion txts) (do-insertion txts #f)
(sync signal))))) (sync signal)))))
;; do-insertion : (listof (cons (union string snip) style-delta)) -> void ;; do-insertion : (listof (cons (union string snip) style-delta)) boolean -> void
;; thread: eventspace main thread ;; thread: eventspace main thread
(define/private (do-insertion txts) (define/private (do-insertion txts showing-input?)
(let ([locked? (is-locked?)]) (let ([locked? (is-locked?)])
(begin-edit-sequence) (begin-edit-sequence)
(lock #f) (lock #f)
@ -1266,6 +1297,11 @@ WARNING: printf is rebound in the body of the unit to always
(loop (cdr txts))])) (loop (cdr txts))]))
(set! allow-edits? #f) (set! allow-edits? #f)
(lock locked?) (lock locked?)
(unless showing-input?
(when box-input
(adjust-box-input-width)
(when (eq? box-input (get-focus-snip))
(scroll-to-position (last-position)))))
(end-edit-sequence) (end-edit-sequence)
(unless (null? txts) (unless (null? txts)
(after-io-insertion)))) (after-io-insertion))))