.
original commit: 1f0bbdd929b5f69c9adde3dbc9c39a293be8d2ef
This commit is contained in:
parent
64785cc351
commit
e1974843df
|
@ -182,6 +182,7 @@
|
|||
the-font-name-directory
|
||||
the-pen-list
|
||||
the-style-list
|
||||
the-x-selection-clipboard
|
||||
timer%
|
||||
top-level-window<%>
|
||||
unregister-collecting-blit
|
||||
|
|
|
@ -2191,6 +2191,13 @@
|
|||
(let ([edit (get-editor)])
|
||||
(when edit
|
||||
(as-exit (lambda () (send edit on-display-size-when-ready))))))]
|
||||
[on-scroll-on-change (lambda ()
|
||||
(queue-window-callback
|
||||
this
|
||||
(lambda ()
|
||||
(let ([edit (get-editor)])
|
||||
(when edit
|
||||
(send edit on-display-size-when-ready))))))]
|
||||
[on-set-focus
|
||||
(entry-point
|
||||
(lambda ()
|
||||
|
@ -4882,7 +4889,9 @@
|
|||
(class100*/kw basic-canvas% ()
|
||||
[(parent [style null] [paint-callback default-paint-cb] [label #f])
|
||||
canvas%-keywords]
|
||||
(private-field [paint-cb paint-callback])
|
||||
(private-field [paint-cb paint-callback]
|
||||
[has-x? (memq 'hscroll style)]
|
||||
[has-y? (memq 'vscroll style)])
|
||||
(inherit get-client-size get-dc set-label)
|
||||
(rename [super-on-paint on-paint])
|
||||
(sequence
|
||||
|
@ -4948,6 +4957,20 @@
|
|||
(send wx set-scrollbars (if x-len 1 0) (if y-len 1 0)
|
||||
(or x-len 0) (or y-len 0) x-page y-page x-val y-val #f))]
|
||||
|
||||
[show-scrollbars
|
||||
(lambda (x-on? y-on?)
|
||||
(let ([bad (lambda (which what)
|
||||
(raise-mismatch-error
|
||||
(who->name '(method canvas% show-scrollbars))
|
||||
(format
|
||||
"cannot show ~a scrollbars, because the canvas style did not include ~a: "
|
||||
which
|
||||
what)
|
||||
this))])
|
||||
(when x-on? (unless has-x? (bad "horizontal" 'hscroll)))
|
||||
(when y-on? (unless has-y? (bad "vertical" 'vscroll)))
|
||||
(send wx show-scrollbars x-on? y-on?)))]
|
||||
|
||||
[get-scroll-pos (entry-point (lambda (d) (send wx get-scroll-pos d)))]
|
||||
[set-scroll-pos (entry-point (lambda (d v) (send wx set-scroll-pos d v)))]
|
||||
[get-scroll-range (entry-point (lambda (d) (send wx get-scroll-range d)))]
|
||||
|
@ -4967,7 +4990,7 @@
|
|||
[(memq 'control-border style) (+ 4 canvas-control-border-extra)]
|
||||
[(memq 'border style) 4]
|
||||
[else 0])
|
||||
(if (or (memq 'vscroll style) (memq 'hscroll style))
|
||||
(if (or has-x? has-y?)
|
||||
canvas-default-size
|
||||
1))])
|
||||
(set! wx (make-object wx-canvas% this this
|
||||
|
@ -4993,7 +5016,9 @@
|
|||
(let ([cwho '(constructor editor-canvas)])
|
||||
(check-container-parent cwho parent)
|
||||
(check-instance cwho internal-editor<%> "text% or pasteboard%" #t editor)
|
||||
(check-style cwho #f '(hide-vscroll hide-hscroll no-vscroll no-hscroll deleted control-border transparent no-border) style)
|
||||
(check-style cwho #f '(hide-vscroll hide-hscroll no-vscroll no-hscroll auto-vscroll auto-hscroll
|
||||
deleted control-border transparent no-border)
|
||||
style)
|
||||
(check-gauge-integer cwho scrolls-per-page)
|
||||
(check-label-string/false cwho label)
|
||||
(unless (eq? wheel-step no-val)
|
||||
|
@ -5893,7 +5918,7 @@
|
|||
eol-box)])
|
||||
(send edit set-position click-pos)))]
|
||||
[else (void)])
|
||||
(send edit paste)))]
|
||||
(send edit paste-x-selection)))]
|
||||
[mouse-popup-menu (lambda (edit event)
|
||||
(when (send event button-up?)
|
||||
(let ([a (send edit get-admin)])
|
||||
|
@ -6017,7 +6042,7 @@
|
|||
(apply super-init args) (accept-drop-files #t)))
|
||||
"MrEd REPL" #f 500 400))
|
||||
(define repl-buffer (make-object esq:text%))
|
||||
(define repl-display-canvas (new editor-canvas% [parent frame] [style '(no-border)]))
|
||||
(define repl-display-canvas (new editor-canvas% [parent frame] [style '(no-border auto-hscroll)]))
|
||||
|
||||
(define esq-eventspace (wx:current-eventspace))
|
||||
(define (queue-output proc)
|
||||
|
@ -7969,6 +7994,7 @@
|
|||
(define the-color-database (wx:get-the-color-database))
|
||||
(define the-font-name-directory (wx:get-the-font-name-directory))
|
||||
(define the-clipboard (wx:get-the-clipboard))
|
||||
(define the-x-selection-clipboard (wx:get-the-x-selection))
|
||||
(define the-font-list (wx:get-the-font-list))
|
||||
(define the-pen-list (wx:get-the-pen-list))
|
||||
(define the-brush-list (wx:get-the-brush-list))
|
||||
|
@ -8061,6 +8087,7 @@
|
|||
get-family-builtin-face
|
||||
send-message-to-window
|
||||
the-clipboard
|
||||
the-x-selection-clipboard
|
||||
the-editor-wordbreak-map
|
||||
the-brush-list
|
||||
the-color-database
|
||||
|
|
|
@ -276,6 +276,7 @@
|
|||
copy-self-to
|
||||
copy-self
|
||||
kill
|
||||
paste-x-selection
|
||||
paste
|
||||
copy
|
||||
cut
|
||||
|
@ -355,6 +356,7 @@
|
|||
scroll
|
||||
warp-pointer
|
||||
view-start
|
||||
show-scrollbars
|
||||
set-scrollbars
|
||||
get-virtual-size
|
||||
get-dc
|
||||
|
@ -663,6 +665,7 @@
|
|||
allow-scroll-to-last
|
||||
force-display-focus
|
||||
is-focus-on?
|
||||
on-scroll-on-change
|
||||
get-editor
|
||||
set-editor
|
||||
get-wheel-step
|
||||
|
@ -802,10 +805,12 @@
|
|||
find-position
|
||||
split-snip
|
||||
change-style
|
||||
do-paste-x-selection
|
||||
do-paste
|
||||
do-copy
|
||||
kill
|
||||
paste-next
|
||||
paste-x-selection
|
||||
paste
|
||||
copy
|
||||
cut
|
||||
|
@ -941,6 +946,7 @@
|
|||
get-clipboard-string
|
||||
set-clipboard-string
|
||||
set-clipboard-client)
|
||||
(define-function get-the-x-selection)
|
||||
(define-function get-the-clipboard)
|
||||
(define-class clipboard-client% object% ()
|
||||
get-types
|
||||
|
@ -1024,6 +1030,7 @@
|
|||
move-to
|
||||
remove
|
||||
erase
|
||||
do-paste-x-selection
|
||||
do-paste
|
||||
do-copy
|
||||
delete
|
||||
|
@ -1080,6 +1087,7 @@
|
|||
copy-self-to
|
||||
copy-self
|
||||
kill
|
||||
paste-x-selection
|
||||
paste
|
||||
copy
|
||||
cut)
|
||||
|
|
Loading…
Reference in New Issue
Block a user