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

Scheme-implemented editor classes; on-demand instantiation of module phases

Browse Source 
svn: r14445
This commit is contained in:
Matthew Flatt 2009-04-07 17:12:22 +00:00
parent 3a297ed003
commit 1d26e97a35
149 changed files with 20675 additions and 77299 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/framework/private/editor.ss
View File

@ -321,6 +321,7 @@
(define/override (on-new-image-snip filename kind relative-path? inline?)
(super on-new-image-snip
filename
(if (eq? kind 'unknown) 'unknown/mask kind)
relative-path?
inline?))

2
collects/mred/edit.ss
View File

@ -158,7 +158,7 @@
(send c set-editor e)
(when file
(if (regexp-match "[.](gif|bmp|jpe?g|xbm|xpm|png)$" file)
(if (regexp-match "[.](gif|bmp|jpe?g|xbm|xpm|png)$" (string-downcase file))
(send e insert (make-object image-snip% file))
(send e load-file file)))

15
collects/mred/mred.ss
View File

@ -6,6 +6,17 @@
scheme/class
mzlib/etc
(prefix wx: "private/kernel.ss")
(prefix wx: "private/wxme/style.ss")
(prefix wx: "private/wxme/editor.ss")
(prefix wx: "private/wxme/text.ss")
(prefix wx: "private/wxme/pasteboard.ss")
(prefix wx: "private/wxme/snip.ss")
(prefix wx: "private/wxme/keymap.ss")
(prefix wx: "private/wxme/editor-admin.ss")
(prefix wx: "private/wxme/editor-snip.ss")
(prefix wx: "private/wxme/stream.ss")
(prefix wx: "private/wxme/wordbreak.ss")
(prefix wx: "private/wxme/snip-admin.ss")
"private/wxtop.ss"
"private/app.ss"
"private/misc.ss"
@ -182,8 +193,8 @@
(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))
(define the-style-list (wx:get-the-style-list))
(define the-editor-wordbreak-map (wx:get-the-editor-wordbreak-map))
(define the-style-list wx:the-style-list)
(define the-editor-wordbreak-map wx:the-editor-wordbreak-map)
(provide button%
canvas%

17
collects/mred/private/editor.ss
View File

@ -5,6 +5,15 @@
mzlib/list
mzlib/file
(prefix wx: "kernel.ss")
(prefix wx: "wxme/style.ss")
(prefix wx: "wxme/keymap.ss")
(prefix wx: "wxme/editor.ss")
(prefix wx: "wxme/text.ss")
(prefix wx: "wxme/pasteboard.ss")
(prefix wx: "wxme/editor-snip.ss")
(rename "wxme/cycle.ss" wx:set-extended-editor-snip%! set-extended-editor-snip%!)
(rename "wxme/cycle.ss" wx:set-extended-text%! set-extended-text%!)
(rename "wxme/cycle.ss" wx:set-extended-pasteboard%! set-extended-pasteboard%!)
"seqcontract.ss"
"lock.ss"
"check.ss"
@ -324,7 +333,7 @@
(when (and can-wrap? auto-set-wrap?)
(let-values ([(current-width) (as-exit (lambda () (get-max-width)))]
[(new-width new-height) (max-view-size)])
(when (and (not (= current-width new-width))
(when (and (not (equal? current-width new-width))
(< 0 new-width))
(as-exit (lambda () (set-max-width new-width)))))))
(as-exit (lambda () (inner (void) on-display-size)))))])
@ -481,9 +490,9 @@
min-height
max-height))))
(wx:set-editor-snip-maker (lambda args (apply make-object editor-snip% args)))
(wx:set-text-editor-maker (lambda () (make-object text%)))
(wx:set-pasteboard-editor-maker (lambda () (make-object pasteboard%)))
(wx:set-extended-editor-snip%! editor-snip%)
(wx:set-extended-text%! text%)
(wx:set-extended-pasteboard%! pasteboard%)
;; ----------------------- Keymap ----------------------------------------

6
collects/mred/private/filedialog.ss
View File

@ -3,6 +3,8 @@
mzlib/etc
mzlib/list
(prefix wx: "kernel.ss")
(prefix wx: "wxme/style.ss")
(prefix wx: "wxme/cycle.ss")
"lock.ss"
"wx.ss"
"cycle.ss"
@ -105,4 +107,6 @@
((mk-file-selector 'get-directory #f #f #t)
message parent directory #f #f style null)))
(set-get-file! get-file))
(set-get-file! get-file)
(wx:set-editor-get-file! get-file)
(wx:set-editor-put-file! put-file))

1
collects/mred/private/helper.ss
View File

@ -1,6 +1,7 @@
(module helper mzscheme
(require mzlib/class
(prefix wx: "kernel.ss")
(prefix wx: "wxme/style.ss")
"lock.ss")
(provide (protect (struct child-info (x-min y-min x-margin y-margin x-stretch y-stretch))

852
collects/mred/private/kernel.ss
View File

@ -160,147 +160,6 @@
on-size
on-set-focus
on-kill-focus)
(define-private-class editor% editor<%> object% () #f
dc-location-to-editor-location
editor-location-to-dc-location
set-inactive-caret-threshold
get-inactive-caret-threshold
get-focus-snip
end-write-header-footer-to-file
begin-write-header-footer-to-file
print
insert-image
insert-box
get-filename
is-modified?
is-locked?
lock
set-cursor
get-paste-text-only
set-paste-text-only
get-load-overwrites-styles
set-load-overwrites-styles
set-style-list
get-style-list
get-keymap
set-keymap
can-do-edit-operation?
do-edit-operation
get-max-undo-history
set-max-undo-history
add-undo
clear-undos
redo
undo
select-all
clear
get-view-size
get-dc
local-to-global
global-to-local
locked-for-flow?
locked-for-write?
locked-for-read?
set-admin
get-admin
print-to-dc
find-scroll-line
num-scroll-lines
scroll-line-location
get-snip-location
locations-computed?
in-edit-sequence?
refresh-delayed?
end-edit-sequence
begin-edit-sequence
style-has-changed
set-min-height
set-max-height
get-min-height
get-max-height
set-min-width
set-max-width
get-min-width
get-max-width
insert-file
load-file
insert-port
save-port
default-style-name
get-flattened-text
put-file
get-file
after-edit-sequence
on-edit-sequence
after-load-file
on-load-file
can-load-file?
after-save-file
on-save-file
can-save-file?
on-new-box
on-new-image-snip
size-cache-invalid
invalidate-bitmap-cache
on-paint
write-footers-to-file
write-headers-to-file
read-footer-from-file
read-header-from-file
write-to-file
read-from-file
set-filename
release-snip
on-snip-modified
set-modified
scroll-editor-to
set-snip-data
get-snip-data
needs-update
resized
set-caret-owner
scroll-to
on-display-size-when-ready
on-display-size
on-change
on-focus
on-default-char
on-default-event
on-local-char
on-local-event
find-first-snip
get-space
get-descent
get-extent
blink-caret
own-caret
refresh
adjust-cursor
on-char
on-event
copy-self-to
copy-self
kill
paste-x-selection
paste
copy
cut
insert
change-style)
(define-function get-the-editor-data-class-list)
(define-function get-the-snip-class-list)
(define-function editor-set-x-selection-mode)
(define-function add-pasteboard-keymap-functions)
(define-function add-text-keymap-functions)
(define-function add-editor-keymap-functions)
(define-function write-editor-global-footer)
(define-function write-editor-global-header)
(define-function read-editor-global-footer)
(define-function read-editor-global-header)
(define-function read-editor-version)
(define-function write-editor-version)
(define-function set-editor-print-margin)
(define-function get-editor-print-margin)
(define-class bitmap% object% () #f
get-argb-pixels
get-gl-config
@ -375,6 +234,7 @@
on-event
on-paint)
(define-private-class dc% dc<%> object% () #f
cache-font-metrics-key
get-alpha
set-alpha
glyph-exists?
@ -711,255 +571,6 @@
on-size
on-set-focus
on-kill-focus)
(define-class editor-canvas% canvas% () #f
on-char
on-event
on-paint
on-drop-file
pre-on-event
pre-on-char
on-size
on-set-focus
on-kill-focus
popup-for-editor
call-as-primary-owner
get-canvas-background
set-canvas-background
set-y-margin
set-x-margin
get-y-margin
get-x-margin
clear-margins
scroll-to
set-lazy-refresh
get-lazy-refresh
scroll-with-bottom-base
allow-scroll-to-last
force-display-focus
is-focus-on?
on-scroll-on-change
get-editor
set-editor
get-wheel-step
set-wheel-step)
(define-class editor-admin% object% () #f
modified
refresh-delayed?
popup-menu
update-cursor
needs-update
resized
grab-caret
scroll-to
get-max-view
get-view
get-dc)
(define-private-class editor-snip-editor-admin% editor-snip-editor-admin<%> editor-admin% () #f
get-snip)
(define-class snip-admin% object% () #f
modified
popup-menu
update-cursor
release-snip
needs-update
recounted
resized
set-caret-owner
scroll-to
get-view
get-view-size
get-dc
get-editor)
(define-class snip-class% object% () #f
reading-version
write-header
read-header
read
get-classname
set-classname
get-version
set-version)
(define-private-class snip-class-list% snip-class-list<%> object% () #f
nth
number
add
find-position
find)
(define-class keymap% object% () #f
remove-chained-keymap
chain-to-keymap
set-break-sequence-callback
call-function
remove-grab-mouse-function
set-grab-mouse-function
remove-grab-key-function
set-grab-key-function
add-function
map-function
break-sequence
handle-mouse-event
handle-key-event
set-double-click-interval
get-double-click-interval)
(define-class editor-wordbreak-map% object% () #f
get-map
set-map)
(define-function get-the-editor-wordbreak-map)
(define-class text% editor% () #f
call-clickback
remove-clickback
set-clickback
set-wordbreak-func
set-autowrap-bitmap
on-reflow
on-new-tab-snip
on-new-string-snip
caret-hidden?
hide-caret
get-wordbreak-map
set-wordbreak-map
find-wordbreak
set-region-data
get-region-data
get-revision-number
after-merge-snips
after-split-snip
after-set-size-constraint
on-set-size-constraint
can-set-size-constraint?
after-set-position
after-change-style
on-change-style
can-change-style?
after-delete
on-delete
can-delete?
after-insert
on-insert
can-insert?
set-tabs
get-tabs
set-overwrite-mode
get-overwrite-mode
set-file-format
get-file-format
write-to-file
read-from-file
get-character
get-text
find-next-non-string-snip
get-snip-position
get-snip-position-and-location
find-snip
find-string-all
find-string
set-styles-sticky
get-styles-sticky
set-line-spacing
get-line-spacing
set-paragraph-alignment
set-paragraph-margins
last-paragraph
paragraph-end-line
paragraph-start-line
line-paragraph
paragraph-end-position
paragraph-start-position
position-paragraph
last-line
last-position
line-length
line-end-position
line-start-position
line-location
position-locations
position-location
position-line
set-between-threshold
get-between-threshold
find-position-in-line
find-line
find-position
split-snip
change-style
do-paste-x-selection
do-paste
do-copy
kill
paste-next
paste-x-selection
paste
copy
cut
erase
delete
insert
get-top-line-base
flash-off
flash-on
get-anchor
set-anchor
get-visible-line-range
get-visible-position-range
scroll-to-position
move-position
set-position-bias-scroll
set-position
get-end-position
get-start-position
get-position
default-style-name
get-flattened-text
put-file
get-file
after-edit-sequence
on-edit-sequence
after-load-file
on-load-file
can-load-file?
after-save-file
on-save-file
can-save-file?
on-new-box
on-new-image-snip
size-cache-invalid
invalidate-bitmap-cache
on-paint
write-footers-to-file
write-headers-to-file
read-footer-from-file
read-header-from-file
set-filename
release-snip
on-snip-modified
set-modified
scroll-editor-to
set-snip-data
get-snip-data
needs-update
resized
set-caret-owner
scroll-to
on-display-size-when-ready
on-display-size
on-change
on-focus
on-default-char
on-default-event
on-local-char
on-local-event
find-first-snip
get-space
get-descent
get-extent
blink-caret
own-caret
refresh
adjust-cursor
on-char
on-event
copy-self-to
copy-self)
(define-class menu% object% () #f
select
get-font
@ -984,46 +595,13 @@
(define-class menu-item% object% () #f
id)
(define-function id-to-menu-item)
(define-class editor-stream-in-base% object% () #f
read
bad?
skip
seek
tell)
(define-class editor-stream-out-base% object% () #f
write
bad?
seek
tell)
(define-class editor-stream-in-bytes-base% editor-stream-in-base% () #f)
(define-class editor-stream-out-bytes-base% editor-stream-out-base% () #f
get-bytes)
(define-class editor-stream-in% object% () #f
ok?
jump-to
tell
skip
remove-boundary
set-boundary
get-inexact
get-exact
get-fixed
get-unterminated-bytes
get-bytes
get)
(define-class editor-stream-out% object% () #f
ok?
pretty-finish
jump-to
tell
put-fixed
put)
(define-class timer% object% () ()
stop
start
notify
interval)
(define-private-class clipboard% clipboard<%> object% () #f
same-clipboard-client?
get-clipboard-bitmap
set-clipboard-bitmap
get-clipboard-data
@ -1033,6 +611,7 @@
(define-function get-the-x-selection)
(define-function get-the-clipboard)
(define-class clipboard-client% object% () ()
same-eventspace?
get-types
add-type
get-data
@ -1063,123 +642,6 @@
get-command)
(define-function show-print-setup)
(define-function can-show-print-setup?)
(define-class pasteboard% editor% () #f
set-scroll-step
get-scroll-step
set-selection-visible
get-selection-visible
set-dragable
get-dragable
after-interactive-resize
on-interactive-resize
can-interactive-resize?
after-interactive-move
on-interactive-move
can-interactive-move?
interactive-adjust-resize
interactive-adjust-move
interactive-adjust-mouse
on-double-click
after-select
on-select
can-select?
after-reorder
on-reorder
can-reorder?
after-resize
on-resize
can-resize?
after-move-to
on-move-to
can-move-to?
after-delete
on-delete
can-delete?
after-insert
on-insert
can-insert?
find-next-selected-snip
is-selected?
find-snip
get-center
remove-selected
no-selected
add-selected
set-selected
change-style
set-after
set-before
lower
raise
resize
move
move-to
remove
erase
do-paste-x-selection
do-paste
do-copy
delete
insert
default-style-name
get-flattened-text
put-file
get-file
after-edit-sequence
on-edit-sequence
after-load-file
on-load-file
can-load-file?
after-save-file
on-save-file
can-save-file?
on-new-box
on-new-image-snip
size-cache-invalid
invalidate-bitmap-cache
on-paint
write-footers-to-file
write-headers-to-file
read-footer-from-file
read-header-from-file
write-to-file
read-from-file
set-filename
release-snip
on-snip-modified
set-modified
scroll-editor-to
set-snip-data
get-snip-data
needs-update
resized
set-caret-owner
scroll-to
on-display-size-when-ready
on-display-size
on-change
on-focus
on-default-char
on-default-event
on-local-char
on-local-event
find-first-snip
get-space
get-descent
get-extent
blink-caret
own-caret
refresh
adjust-cursor
on-char
on-event
copy-self-to
copy-self
kill
paste-x-selection
paste
copy
cut)
(define-class panel% window% () #f
get-label-position
set-label-position
@ -1227,302 +689,6 @@
on-size
on-set-focus
on-kill-focus)
(define-class snip% object% () #f
previous
next
set-unmodified
get-scroll-step-offset
find-scroll-step
get-num-scroll-steps
set-admin
resize
write
match?
can-do-edit-operation?
do-edit-operation
blink-caret
own-caret
adjust-cursor
on-char
on-event
size-cache-invalid
copy
get-text!
get-text
merge-with
split
draw
partial-offset
get-extent
release-from-owner
is-owned?
set-style
set-flags
set-count
get-admin
get-count
get-flags
get-style
get-snipclass
set-snipclass)
(define-class string-snip% snip% () #f
read
insert
set-unmodified
get-scroll-step-offset
find-scroll-step
get-num-scroll-steps
set-admin
resize
write
match?
can-do-edit-operation?
do-edit-operation
blink-caret
own-caret
adjust-cursor
on-char
on-event
size-cache-invalid
copy
get-text!
get-text
merge-with
split
draw
partial-offset
get-extent)
(define-class tab-snip% string-snip% () #f
set-unmodified
get-scroll-step-offset
find-scroll-step
get-num-scroll-steps
set-admin
resize
write
match?
can-do-edit-operation?
do-edit-operation
blink-caret
own-caret
adjust-cursor
on-char
on-event
size-cache-invalid
copy
get-text!
get-text
merge-with
split
draw
partial-offset
get-extent)
(define-class image-snip% snip% (equal<%>) #f
equal-secondary-hash-code-of
equal-hash-code-of
other-equal-to?
equal-to?
set-offset
get-bitmap-mask
get-bitmap
set-bitmap
get-filetype
get-filename
load-file
set-unmodified
get-scroll-step-offset
find-scroll-step
get-num-scroll-steps
set-admin
resize
write
match?
can-do-edit-operation?
do-edit-operation
blink-caret
own-caret
adjust-cursor
on-char
on-event
size-cache-invalid
copy
get-text!
get-text
merge-with
split
draw
partial-offset
get-extent)
(define-class editor-snip% snip% () #f
get-inset
set-inset
get-margin
set-margin
style-background-used?
use-style-background
border-visible?
show-border
set-align-top-line
get-align-top-line
set-tight-text-fit
get-tight-text-fit
get-min-height
get-min-width
set-min-height
set-min-width
get-max-height
get-max-width
set-max-height
set-max-width
set-unmodified
get-scroll-step-offset
find-scroll-step
get-num-scroll-steps
set-admin
resize
write
match?
can-do-edit-operation?
do-edit-operation
blink-caret
own-caret
adjust-cursor
on-char
on-event
size-cache-invalid
copy
get-text!
get-text
merge-with
split
draw
partial-offset
get-extent
set-editor
get-editor)
(define-class editor-data-class% object% () #f
read
get-classname
set-classname)
(define-private-class editor-data-class-list% editor-data-class-list<%> object% () #f
nth
number
add
find-position
find)
(define-class editor-data% object% () #f
set-next
write
get-dataclass
set-dataclass
get-next)
(define-private-class mult-color% mult-color<%> object% () #f
set
get
get-r
set-r
get-g
set-g
get-b
set-b)
(define-private-class add-color% add-color<%> object% () #f
set
get
get-r
set-r
get-g
set-g
get-b
set-b)
(define-class style-delta% object% () #f
copy
collapse
equal?
set-delta-foreground
set-delta-background
set-delta-face
set-delta
get-family
set-family
get-face
set-face
get-size-mult
set-size-mult
get-size-add
set-size-add
get-weight-on
set-weight-on
get-weight-off
set-weight-off
get-smoothing-on
set-smoothing-on
get-smoothing-off
set-smoothing-off
get-style-on
set-style-on
get-style-off
set-style-off
get-underlined-on
set-underlined-on
get-underlined-off
set-underlined-off
get-size-in-pixels-on
set-size-in-pixels-on
get-size-in-pixels-off
set-size-in-pixels-off
get-transparent-text-backing-on
set-transparent-text-backing-on
get-transparent-text-backing-off
set-transparent-text-backing-off
get-foreground-mult
get-background-mult
get-foreground-add
get-background-add
get-alignment-on
set-alignment-on
get-alignment-off
set-alignment-off)
(define-private-class style% style<%> object% () #f
switch-to
set-shift-style
get-shift-style
is-join?
set-delta
get-delta
set-base-style
get-base-style
get-text-width
get-text-space
get-text-descent
get-text-height
get-transparent-text-backing
get-alignment
get-background
get-foreground
get-font
get-size-in-pixels
get-underlined
get-smoothing
get-style
get-weight
get-size
get-face
get-family
get-name)
(define-class style-list% object% () #f
forget-notification
notify-on-change
style-to-index
index-to-style
convert
replace-named-style
new-named-style
find-named-style
find-or-create-join-style
find-or-create-style
number
basic-style)
(define-function get-the-style-list)
(define-class tab-group% item% () #f
button-focus
set
@ -1551,7 +717,6 @@
(define-functions
special-control-key
special-option-key
map-command-as-meta-key
application-file-handler
application-quit-handler
application-about-handler
@ -1576,20 +741,19 @@
shortcut-visible-in-label?
eventspace-shutdown?
in-atomic-region
set-editor-snip-maker
set-text-editor-maker
set-pasteboard-editor-maker
set-menu-tester
location->window
set-dialogs
set-executer
send-event
file-creator-and-type
set-snip-class-getter
set-editor-data-class-getter
set-ps-procs
main-eventspace?
eventspace-handler-thread)
eventspace-handler-thread
begin-refresh-sequence
end-refresh-sequence
run-printout
get-double-click-time)
)
;; end

1
collects/mred/private/moredialogs.ss
View File

@ -3,6 +3,7 @@
mzlib/etc
mzlib/list
(prefix wx: "kernel.ss")
(prefix wx: "wxme/style.ss")
"lock.ss"
"const.ss"
"check.ss"

8
collects/mred/private/mrmenu.ss
View File

@ -3,6 +3,7 @@
mzlib/class100
mzlib/list
(prefix wx: "kernel.ss")
(prefix wx: "wxme/keymap.ss")
"lock.ss"
"const.ss"
"helper.ss"
@ -285,11 +286,12 @@
":"
"")])
(case (system-type)
[(unix windows) (format "~a~a~a~a~a?:~a"
[(unix windows) (format "~a~a~a~a?:~a"
exact
(if (memq 'shift prefix) "s:" "")
(if (memq 'meta prefix) "m:" "~m:")
(if (memq 'alt prefix) "m:" "~m:")
(if (or (memq 'meta prefix)
(memq 'alt prefix))
"m:" "~m:")
(if (memq 'ctl prefix) "c:" "")
base)]
[(macosx) (format "~a~a~a~a~a?:~a"

5
collects/mred/private/mrpopup.ss
View File

@ -3,6 +3,7 @@
mzlib/class100
mzlib/list
(prefix wx: "kernel.ss")
(prefix wx: "wxme/cycle.ss")
"lock.ss"
"const.ss"
"helper.ss"
@ -63,4 +64,6 @@
(wx:queue-callback go wx:middle-queue-key)
(go))))
(no-val->#f font)))
(super-init wx)))))))
(super-init wx))))))
(wx:set-popup-menu%! popup-menu%))

1
collects/mred/private/path-dialog.ss
View File

@ -1,6 +1,7 @@
(module path-dialog mzscheme
(require mzlib/class mzlib/list mzlib/string mzlib/file
(prefix wx: "kernel.ss")
(prefix wx: "wxme/style.ss")
"helper.ss" "mrtop.ss" "mritem.ss" "mrpanel.ss" "mrtextfield.ss"
"messagebox.ss" "mrmenu.ss" (only scheme/base compose))
(provide path-dialog%)

1
collects/mred/private/repl.ss
View File

@ -2,6 +2,7 @@
(require mzlib/class
mzlib/class100
(prefix wx: "kernel.ss")
(prefix wx: "wxme/style.ss")
"editor.ss"
"app.ss"
"mrtop.ss"

2
collects/mred/private/seqcontract.ss
View File

@ -245,7 +245,7 @@ Matthew
(not (locked-for-read?)))
(set-position [(x) (x y) (x y z) (x y z p) (x y z p q)] unlocked)
(set-autowrap-bitmap [(bitmap)] unlocked)
(print-to-dc [(dc)] unlocked)
(print-to-dc [(dc) (dc page)] unlocked)
(move-position [(code?) (code? extend) (code? extend kind)] unlocked)
(split-snip [(pos)] unlocked)
(set-line-spacing [(space)] unlocked)

6
collects/mred/private/snipfile.ss
View File

@ -4,6 +4,8 @@
mzlib/port
syntax/moddep
(prefix wx: "kernel.ss")
(prefix wx: "wxme/snip.ss")
(prefix wx: "wxme/cycle.ss")
"check.ss"
"editor.ss")
@ -50,10 +52,10 @@
(error 'load-class "not a ~a% instance" id))))
#f)))])
;; install the getters:
(wx:set-snip-class-getter
(wx:set-get-snip-class!
(lambda (name)
(load-one name 'snip-class wx:snip-class%)))
(wx:set-editor-data-class-getter
(wx:set-get-editor-data-class!
(lambda (name)
(load-one name 'editor-data-class wx:editor-data-class%))))

266
collects/mred/private/syntax.ss Normal file
View File

@ -0,0 +1,266 @@
#lang scheme/base
(require scheme/class
scheme/stxparam
(for-syntax scheme/base))
(provide defclass defclass*
def/public def/override define/top case-args
maybe-box? any? bool? nonnegative-real? make-or-false make-box make-list make-alts
make-literal symbol-in make-procedure
method-name init-name
let-boxes
properties field-properties init-properties
->long)
(define-syntax-parameter class-name #f)
(define-syntax-rule (defclass name super . body)
(defclass* name super () . body))
(define-syntax-rule (defclass* name super intfs . body)
(define name
(syntax-parameterize ([class-name 'name])
(class* super intfs . body))))
(define-syntax (def/public stx)
#`(def/thing define/public #,stx))
(define-syntax (def/override stx)
#`(def/thing define/override #,stx))
(define-syntax (define/top stx)
#`(def/thing define #,stx))
(define (method-name class method)
(string->symbol (format "~a in ~a" method class)))
(define (init-name class)
(string->symbol (format "initialization for ~a" class)))
(define-syntax just-id
(syntax-rules ()
[(_ [id default]) id]
[(_ id) id]))
(define-struct named-pred (pred make-name)
#:property prop:procedure (struct-field-index pred))
(define (apply-pred pred val)
(cond
[(procedure? pred) (pred val)]
[(class? pred) (val . is-a? . pred)]
[(interface? pred) (val . is-a? . pred)]
[else (error 'check-arg "unknown predicate type: ~e" pred)]))
(define (make-or-false pred)
(make-named-pred (lambda (v)
(or (not v) (apply-pred pred v)))
(lambda ()
(string-append (predicate-name pred)
" or #f"))))
(define (make-box pred)
(make-named-pred (lambda (v)
(and (box? v) (apply-pred pred (unbox v))))
(lambda ()
(string-append "boxed " (predicate-name pred)))))
(define (make-list pred)
(make-named-pred (lambda (v)
(and (list? v) (andmap (lambda (v) (apply-pred pred v)) v)))
(lambda ()
(string-append "list of " (predicate-name pred)))))
(define (make-alts a b)
(make-named-pred (lambda (v)
(or (apply-pred a v) (apply-pred b v)))
(lambda ()
(string-append (predicate-name a)
" or "
(predicate-name b)))))
(define (make-literal lit)
(make-named-pred (lambda (v) (equal? v lit))
(lambda () (if (symbol? lit)
(format "'~s" lit)
(format "~s" lit)))))
(define (make-symbol syms)
(make-named-pred (lambda (v) (memq v syms))
(lambda ()
(let loop ([syms syms])
(cond
[(null? (cdr syms))
(format "'~s" (car syms))]
[(null? (cddr syms))
(format "'~s, or '~s" (car syms) (cadr syms))]
[else
(format "'~s, ~a" (car syms) (loop (cdr syms)))])))))
(define-syntax-rule (symbol-in sym ...)
(make-symbol '(sym ...)))
(define (make-procedure arity)
(make-named-pred (lambda (p)
(and (procedure? p)
(procedure-arity-includes? p arity)))
(lambda ()
(format "procedure (arity ~a)" arity))))
(define (check-arg val pred pos)
(if (apply-pred pred val)
#f
(cons (predicate-name pred)
pos)))
(define (predicate-name pred)
(cond
[(named-pred? pred) ((named-pred-make-name pred))]
[(procedure? pred) (let ([s (symbol->string (object-name pred))])
(substring s 0 (sub1 (string-length s))))]
[(or (class? pred) (interface? pred))
(format "~a instance" (object-name pred))]
[else "???"]))
(define maybe-box? (make-named-pred (lambda (v) (or (not v) (box? v)))
(lambda () "box or #f")))
(define (any? v) #t)
(define (bool? v) #t)
(define (nonnegative-real? v) (and (real? v) (v . >= . 0)))
(define (method-of cls nam)
(if cls
(string->symbol (format "~a method of ~a" nam cls))
nam))
(define-syntax (def/thing stx)
(syntax-case stx ()
[(_ define/orig (_ (id [arg-type arg] ...)))
(raise-syntax-error #f "missing body" stx)]
[(_ define/orig (_ (id [arg-type arg] ...) . body))
(with-syntax ([(_ _ orig-stx) stx]
[(pos ...) (for/list ([i (in-range (length (syntax->list #'(arg ...))))])
i)]
[cname (syntax-parameter-value #'class-name)])
(syntax/loc #'orig-stx
(define/orig (id arg ...)
(let ([bad (or (check-arg (just-id arg) arg-type pos)
...)])
(when bad
(raise-type-error (method-of 'cname 'id) (car bad) (cdr bad) (just-id arg) ...)))
(let ()
. body))))]))
(define-for-syntax lifted (make-hash))
(define-syntax (lift-predicate stx)
(syntax-case stx ()
[(_ id) (identifier? #'id) #'id]
[(_ expr)
(let ([d (syntax->datum #'expr)])
(or (hash-ref lifted d #f)
(let ([id (syntax-local-lift-expression #'expr)])
(hash-set! lifted d id)
id)))]))
(define-syntax (case-args stx)
(syntax-case stx ()
[(_ expr [([arg-type arg] ...) rhs ...] ... who)
(with-syntax ([((min-args-len . max-args-len) ...)
(map (lambda (args)
(let ([args (syntax->list args)])
(cons (let loop ([args args])
(if (or (null? args)
(not (identifier? (car args))))
0
(add1 (loop (cdr args)))))
(length args))))
(syntax->list #'((arg ...) ...)))])
#'(let* ([args expr]
[len (length args)])
(find-match
(lambda (next)
(if (and (len . >= . min-args-len)
(len . <= . max-args-len))
(apply
(lambda (arg ...)
(if (and (not (check-arg (just-id arg) (lift-predicate arg-type) 0)) ...)
(lambda () rhs ...)
next))
args)
next))
...
(lambda (next)
(bad-args who args)))))]))
(define (bad-args who args)
(error who "bad argument combination:~a"
(apply string-append (map (lambda (x) (format " ~e" x))
args))))
(define-syntax find-match
(syntax-rules ()
[(_ proc)
((proc #f))]
[(_ proc1 proc ...)
((proc1 (lambda () (find-match proc ...))))]))
(define-syntax-rule (let-boxes ([id init] ...)
call
body ...)
(let ([id (box init)] ...)
call
(let ([id (unbox id)] ...)
body ...)))
(define-syntax (do-properties stx)
(syntax-case stx ()
[(_ define-base check-immutable [[type id] expr] ...)
(let ([ids (syntax->list #'(id ...))])
(with-syntax ([(getter ...)
(map (lambda (id)
(datum->syntax id
(string->symbol
(format "get-~a" (syntax-e id)))
id))
ids)]
[(setter ...)
(map (lambda (id)
(datum->syntax id
(string->symbol
(format "set-~a" (syntax-e id)))
id))
ids)])
#'(begin
(define-base id expr) ...
(define/public (getter) id) ...
(def/public (setter [type v]) (check-immutable 'setter) (set! id (coerce type v))) ...)))]))
(define-syntax coerce
(syntax-rules (bool?)
[(_ bool? v) (and v #t)]
[(_ _ v) v]))
(define-syntax properties
(syntax-rules ()
[(_ #:check-immutable check-immutable . props)
(do-properties define check-immutable . props)]
[(_ . props)
(do-properties define void . props)]))
(define-syntax field-properties
(syntax-rules ()
[(_ #:check-immutable check-immutable . props)
(do-properties define-field check-immutable . props)]
[(_ . props)
(do-properties define-field void . props)]))
(define-syntax-rule (define-field id val) (field [id val]))
(define-syntax init-properties
(syntax-rules ()
[(_ #:check-immutable check-immutable . props)
(do-properties define-init check-immutable . props)]
[(_ . props)
(do-properties define-init void . props)]))
(define-syntax-rule (define-init id val) (begin
(init [(internal id) val])
(define id internal)))
(define (->long i)
(cond
[(eqv? -inf.0 i) (- (expt 2 64))]
[(eqv? +inf.0 i) (expt 2 64)]
[(eqv? +nan.0 i) 0]
[else (inexact->exact (floor i))]))

11
collects/mred/private/wxcanvas.ss
View File

@ -2,6 +2,8 @@
(require mzlib/class
mzlib/class100
(prefix wx: "kernel.ss")
(prefix wx: "wxme/text.ss")
(prefix wx: "wxme/editor-canvas.ss")
"lock.ss"
"helper.ss"
"wx.ss"
@ -216,6 +218,11 @@
(when mred
(as-exit (lambda () (send init-buffer add-canvas mred)))))))))
(define wx-editor-canvas% (make-canvas-glue%
(define wx-editor-canvas%
(class (make-canvas-glue%
(make-editor-canvas% (make-control% wx:editor-canvas%
0 0 #t #t)))))
0 0 #t #t)))
(inherit editor-canvas-on-scroll)
(define/override (on-scroll e)
(editor-canvas-on-scroll))
(super-new))))

5
collects/mred/private/wxme/const.ss Normal file
View File

@ -0,0 +1,5 @@
#lang scheme/base
(provide (all-defined-out))
(define CURSOR-WIDTH 2)

27
collects/mred/private/wxme/cycle.ss Normal file
View File

@ -0,0 +1,27 @@
#lang scheme/base
(define-syntax-rule (decl id set-id)
(begin
(provide id set-id)
(define id #f)
(define (set-id v) (set! id v))))
(decl text% set-text%!)
(decl pasteboard% set-pasteboard%!)
(decl snip-admin% set-snip-admin%!)
(decl editor-stream-in% set-editor-stream-in%!)
(decl editor-stream-out% set-editor-stream-out%!)
(decl editor-snip% set-editor-snip%!)
(decl editor-snip-editor-admin% set-editor-snip-editor-admin%!)
(decl extended-editor-snip% set-extended-editor-snip%!)
(decl extended-text% set-extended-text%!)
(decl extended-pasteboard% set-extended-pasteboard%!)
(decl get-snip-class set-get-snip-class!)
(decl get-editor-data-class set-get-editor-data-class!)
(decl editor-get-file set-editor-get-file!)
(decl editor-put-file set-editor-put-file!)
(decl popup-menu% set-popup-menu%!)

57
collects/mred/private/wxme/editor-admin.ss Normal file
View File

@ -0,0 +1,57 @@
#lang scheme/base
(require scheme/class
"../syntax.ss"
"snip.ss"
"private.ss"
(only-in "cycle.ss" popup-menu%))
(provide editor-admin%)
(defclass editor-admin% object%
(super-new)
(define standard 0) ; used to recognize standard display
(define/public (get-s-standard) standard)
(define/public (set-s-standard v) (set! standard v))
(def/public (get-dc [maybe-box? [x #f]] [maybe-box? [y #f]])
(when x (set-box! x 0.0))
(when y (set-box! y 0.0))
#f)
(define/private (do-get-view x y w h)
(when x (set-box! x 0.0))
(when y (set-box! y 0.0))
(when w (set-box! w 0.0))
(when h (set-box! h 0.0)))
(def/public (get-view [maybe-box? x] [maybe-box? y]
[maybe-box? w] [maybe-box? h]
[any? [full? #f]])
(do-get-view x y w h))
(def/public (get-max-view [maybe-box? x] [maybe-box? y]
[maybe-box? w] [maybe-box? h]
[any? [full? #f]])
(get-view x y w h))
(def/public (scroll-to [real? localx] [real? localy] [real? w] [real? h] [any? [refresh? #t]]
[(symbol-in start none end) [bias 'none]])
(void))
(def/public (grab-caret [(symbol-in immediate display global) dist])
(void))
(def/public (resized [any? redraw-now]) (void))
(def/public (needs-update [real? x] [real? y]
[nonnegative-real? w] [nonnegative-real? h])
(void))
(def/public (update-cursor) (void))
(def/public (delay-refresh?) #f)
(def/public (popup-menu [popup-menu% m] [real? x] [real? y]) #f)
(def/public (modified [any? mod?]) (void)))

1133
collects/mred/private/wxme/editor-canvas.ss Normal file
View File

File diff suppressed because it is too large Load Diff

716
collects/mred/private/wxme/editor-snip.ss Normal file
View File

@ -0,0 +1,716 @@
#lang scheme/base
(require scheme/class
"../syntax.ss"
"private.ss"
"const.ss"
"snip.ss"
"snip-flags.ss"
"editor.ss"
"editor-admin.ss"
"snip-admin.ss"
"text.ss"
"pasteboard.ss"
"wx.ss"
(except-in "cycle.ss"
text%
pasteboard%
editor-snip%
editor-snip-editor-admin%
snip-admin%))
(provide editor-snip%
editor-snip-editor-admin<%>)
;; FIXME: use "type"s
(define-syntax-rule (private-inits [[type id] val] ...)
(begin
(define-init id val)
...))
(define-syntax-rule (define-init id v)
(begin
(init [(init-tmp id) v])
(define id init-tmp)))
;; see also "private.ss"
(define-local-member-name
with-dc
do-get-left-margin do-get-right-margin do-get-bottom-margin do-get-top-margin
do-get-extent)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass editor-snip% snip%
(private-inits
[[(make-or-false editor<%>) editor] #f]
[[bool? with-border?] #t]
[[exact-nonnegative-integer? left-margin] 5]
[[exact-nonnegative-integer? top-margin] 5]
[[exact-nonnegative-integer? right-margin] 5]
[[exact-nonnegative-integer? bottom-margin] 5]
[[exact-nonnegative-integer? left-inset] 1]
[[exact-nonnegative-integer? top-inset] 1]
[[exact-nonnegative-integer? right-inset] 1]
[[exact-nonnegative-integer? bottom-inset] 1]
[[(make-alts (symbol-in none) nonnegative-real?) min-width] 'none]
[[(make-alts (symbol-in none) nonnegative-real?) max-width] 'none]
[[(make-alts (symbol-in none) nonnegative-real?) min-height] 'none]
[[(make-alts (symbol-in none) nonnegative-real?) max-height] 'none])
(unless (symbol? min-width) (set! min-width (exact->inexact min-width)))
(unless (symbol? max-width) (set! max-width (exact->inexact max-width)))
(unless (symbol? min-height) (set! min-height (exact->inexact min-height)))
(unless (symbol? max-height) (set! max-height (exact->inexact max-height)))
(define align-top-line? #f)
(define tight-fit? #f)
(define use-style-bg? #f)
(super-new)
(inherit set-snipclass
do-copy-to)
(inherit-field s-admin
s-flags
s-style)
(set-snipclass the-editor-snip-class)
(when (and editor (send editor get-admin))
(set! editor #f))
(unless editor
(set! editor (new extended-text%)))
(define my-admin (new editor-snip-editor-admin% [owner this]))
(set! s-flags (add-flag s-flags HANDLES-EVENTS))
(when (no-permanent-filename? editor)
(set! s-flags (add-flag s-flags USES-BUFFER-PATH)))
(send editor own-caret #f)
;; ----------------------------------------
(define/private (no-permanent-filename? editor)
(let ([temp (box #f)])
(let ([fn (send editor get-filename temp)])
(or (not fn) (unbox temp)))))
(def/override (set-admin [(make-or-false snip-admin%) a])
(when (not (eq? a s-admin))
(super set-admin a)
(when editor
(if a
(begin
(when (send editor get-admin)
;; traitor! - get rid of it
(set! editor #f))
(send editor set-admin my-admin))
(send editor set-admin #f))))
(when (and s-admin
(has-flag? s-flags USES-BUFFER-PATH))
;; propogate a filename change:
(if (and editor
(no-permanent-filename? editor))
(let ([b (send s-admin get-editor)])
(when b
(let ([fn (send b get-filename)])
(when fn
(send editor set-filename fn #t)))))
(set! s-flags (remove-flag s-flags USES-BUFFER-PATH)))) ;; turn off the flag; not needed
(void))
(def/public (set-editor [editor<%> b])
(unless (eq? editor b)
(when (and editor s-admin)
(send editor set-admin #f))
(set! editor b)
(when b
(cond
[(send b get-admin)
(set! editor #f)]
[s-admin
(send editor set-admin my-admin)]))
(when s-admin
(send s-admin resized this #t))))
(def/public (get-editor)
editor)
(def/override (adjust-cursor [dc<%> dc] [real? x] [real? y] [real? ex] [real? ey] [mouse-event% event])
(if (not editor)
#f
(send my-admin
with-dc
dc x y
(lambda ()
(send editor adjust-cursor event)))))
(def/override (on-event [dc<%> dc] [real? x] [real? y] [real? ex] [real? ey] [mouse-event% event])
(when editor
(send my-admin
with-dc
dc x y
(lambda ()
(send editor on-event event)))))
(def/override (on-char [dc<%> dc] [real? x] [real? y] [real? ex] [real? ey] [key-event% event])
(when editor
(send my-admin
with-dc
dc x y
(lambda ()
(send editor on-char event)))))
(def/override (own-caret [bool? own?])
(when editor
(send editor own-caret own?)))
(def/override (blink-caret [dc<%> dc] [real? x] [real? y])
(when editor
(send my-admin
with-dc
dc x y
(lambda ()
(send editor blink-caret)))))
(def/override (do-edit-operation [symbol? op] [any? [recur? #t]] [exact-integer? [timestamp 0]])
(when editor
(send editor do-edit-operation op recur? timestamp)))
(def/override (can-do-edit-operation? [symbol? op] [any? [recur? #t]])
(and editor
(send editor can-do-edit-operation? op recur?)))
(def/override (match [snip% s])
#f)
(def/override (size-cache-invalid)
(when editor
(send editor size-cache-invalid)))
(def/override (get-text [exact-nonnegative-integer? offset] [exact-integer? num]
[any? [flattened? #f]])
(cond
[(or (offset . >= . 1)
(zero? num))
""]
[(not flattened?)
"."]
[editor
(send editor get-flattened-text)]
[else ""]))
(define/public (do-get-extent dc x y w h -descent -space lspace rspace)
(send my-admin
with-dc
dc x y
(lambda ()
(let ([h2 (or h (box 0.0))])
(if editor
(send editor get-extent w h2)
(begin
(when w (set-box! w 0.0))
(set-box! h2 0.0)))
(let ([orig-h (if align-top-line?
(unbox h2)
0.0)])
(when w
(when (editor . is-a? . text%)
(set-box!
w
(- (unbox w)
(if tight-fit?
CURSOR-WIDTH
1)))) ;; it still looks better to subtract 1
(when ((unbox w) . < . (if (symbol? min-width) -inf.0 min-width))
(set-box! w min-width))
(when ((unbox w) . > . (if (symbol? max-width) +inf.0 max-width))
(set-box! w max-width))
(set-box! w (+ (unbox w) (+ right-margin left-margin))))
(when h
(when (editor . is-a? . text%)
(when tight-fit?
(set-box! h
(max 0.0
(- (unbox h)
(send editor get-line-spacing))))))
(when ((unbox h) . < . (if (symbol? min-height) -inf.0 min-height))
(set-box! h min-height))
(when ((unbox h) . > . (if (symbol? max-height) +inf.0 max-height))
(set-box! h max-height))
(set-box! h (+ (unbox h) (+ top-margin bottom-margin))))
(let* ([descent (+ (if editor
(send editor get-descent)
0.0)
bottom-margin)]
[descent
(if (editor . is-a? . text%)
(let ([descent (if align-top-line?
(- orig-h
(+ (send editor get-top-line-base)
bottom-margin))
descent)])
(if tight-fit?
(max (- descent (send editor get-line-spacing)) 0.0)
descent))
descent)]
[space (+ (if editor
(send editor get-space)
0.0)
top-margin)])
(let-values ([(space descent)
(if (and (not (symbol? max-height))
((+ descent space) . >= . (+ max-height top-margin bottom-margin)))
;; just give up on spaces in this case:
(values top-margin bottom-margin)
(values space descent))])
(when -descent (set-box! -descent descent))
(when -space (set-box! -space space))))
(when lspace (set-box! lspace left-margin))
(when rspace (set-box! rspace right-margin)))))))
(def/override (get-extent [dc<%> dc] [real? x] [real? y]
[maybe-box? [w #f]] [maybe-box? [h #f]]
[maybe-box? [-descent #f]] [maybe-box? [-space #f]]
[maybe-box? [lspace #f]] [maybe-box? [rspace #f]])
(do-get-extent dc x y w h -descent -space lspace rspace))
(def/override (draw [dc<%> dc] [real? x] [real? y]
[real? left] [real? top] [real? right] [real? bottom]
[real? dx] [real? dy] [symbol? caret])
(send my-admin
with-dc
dc x y
(lambda ()
(let-boxes ([w 0.0]
[h 0.0])
(when editor
(send editor get-extent w h)
(when (editor . is-a? . text%)
(set-box! w (max 0.0
(- (unbox w)
(if tight-fit?
CURSOR-WIDTH
1)))) ;; it still looks better to subtract 1
(when tight-fit?
(set-box! h (max 0.0
(- (unbox h)
(send editor get-line-spacing)))))))
(let* ([w (min (max w (if (symbol? min-width) -inf.0 min-width))
(if (symbol? max-width) +inf.0 max-width))]
[h (min (max h (if (symbol? min-height) -inf.0 min-height))
(if (symbol? max-height) +inf.0 max-height))]
[orig-x x]
[orig-y y]
[x (+ x left-margin)]
[y (+ y top-margin)]
[r (+ x w)]
[b (+ y h)]
[l (max x left)]
[t (max y top)]
[r (min r right)]
[b (min b bottom)])
(let ([bg-color
(cond
[(not use-style-bg?)
(make-object color% 255 255 255)]
[(send s-style get-transparent-text-backing)
#f]
[else
(let ([bg-color (send s-style get-background)])
(let ([l (+ orig-x left-inset)]
[t (+ orig-y top-inset)]
[r (+ l w left-margin right-margin
(- (+ left-inset right-inset))
-1)]
[b (+ t h top-margin bottom-margin
(- (+ top-inset bottom-inset))
-1)])
(let ([trans-pen (send the-pen-list
find-or-create-pen
bg-color 0 'transparent)]
[fill (send the-brush-list
find-or-create-brush
bg-color 'solid)]
[savep (send dc get-pen)]
[saveb (send dc get-brush)])
(send dc set-pen trans-pen)
(send dc set-brush fill)
(send dc draw-rectangle l t (- r l) (- b t))
(send dc set-brush saveb)
(send dc set-pen savep)))
bg-color)])])
(when editor
(send editor refresh
(- l x) (- t y) (max 0.0 (- r l)) (max 0.0 (- b t))
caret bg-color))
(when with-border?
(let* ([l (+ orig-x left-inset)]
[t (+ orig-y top-inset)]
[r (+ l w left-margin right-margin
(- (+ left-inset right-inset))
-1)]
[b (+ t h top-margin bottom-margin
(- (+ top-inset bottom-inset))
-1)])
(let ([ml (max (min l right) left)]
[mr (max (min r right) left)]
[mt (max (min t bottom) top)]
[mb (max (min b bottom) top)])
(when (and (l . >= . left)
(l . < . right)
(mt . < . mb))
(send dc draw-line l mt l mb))
(when (and (r . >= . left)
(r . < . right)
(mt . < . mb))
(send dc draw-line r mt r mb))
(when (and (t . >= . top)
(t . < . bottom)
(ml . < . mr))
(send dc draw-line ml t mr t))
(when (and (b . >= . top)
(b . < . bottom)
(ml . < . mr))
(send dc draw-line ml b mr b)))))))))))
(def/override (copy)
(let* ([mb (and editor
(send editor copy-self))]
[ms (make-object extended-editor-snip%
mb
with-border?
left-margin top-margin
right-margin bottom-margin
left-inset top-inset
right-inset bottom-inset
min-width max-width
min-height max-height)])
(do-copy-to ms)
(send ms do-set-graphics tight-fit? align-top-line? use-style-bg?)
(when (not editor)
(send ms set-editor #f))
ms))
(define/public (do-set-graphics tf? atl? usb?)
(set! tight-fit? tf?)
(set! align-top-line? atl?)
(set! use-style-bg? usb?))
(def/override (write [editor-stream-out% f])
(send f put (if editor
(if (editor . is-a? . pasteboard%) 2 1)
0))
(send f put (if with-border? 1 0))
(send f put left-margin)
(send f put top-margin)
(send f put right-margin)
(send f put bottom-margin)
(send f put left-inset)
(send f put top-inset)
(send f put right-inset)
(send f put bottom-inset)
(send f put (if (symbol? min-width) -1.0 min-width))
(send f put (if (symbol? max-width) -1.0 max-width))
(send f put (if (symbol? min-height) -1.0 min-height))
(send f put (if (symbol? max-height) -1.0 max-height))
(send f put (if tight-fit? 1 0))
(send f put (if align-top-line? 1 0))
(send f put (if use-style-bg? 1 0))
(when editor
(send editor write-to-file f)))
(define/private (resize-me)
(when s-admin (send s-admin resized this #t)))
(def/public (set-max-width [(make-alts (symbol-in none) nonnegative-real?) w])
(set! max-width w)
(resize-me))
(def/public (set-min-width [(make-alts (symbol-in none) nonnegative-real?) w])
(set! min-width w)
(resize-me))
(def/public (set-max-height [(make-alts (symbol-in none) nonnegative-real?) h])
(set! max-height h)
(resize-me))
(def/public (set-min-height [(make-alts (symbol-in none) nonnegative-real?) h])
(set! min-height h)
(resize-me))
(def/public (get-max-width) max-width)
(def/public (get-min-width) min-width)
(def/public (get-max-height) max-height)
(def/public (get-min-height) min-height)
(def/public (get-tight-text-fit)
tight-fit?)
(def/public (set-tight-text-fit [bool? t])
(set! tight-fit? t)
(resize-me))
(def/public (get-align-top-line)
align-top-line?)
(def/public (set-align-top-line [bool? t])
(set! align-top-line? t)
(resize-me))
(def/public (style-background-used?)
use-style-bg?)
(def/public (use-style-background [bool? u])
(unless (eq? use-style-bg? u)
(set! use-style-bg? u)
(request-refresh)))
(def/override (resize [real? w] [real? h])
(let ([w (max 0.0 (- w (+ left-margin right-margin)))]
[h (max 0.0 (- h (+ top-margin bottom-margin)))])
(set! min-width w)
(set! max-width w)
(set! min-height h)
(set! max-height h)
(when editor
(send editor set-max-width w)
(send editor set-min-width w))
(resize-me)
#t))
(define/private (request-refresh)
(when s-admin
(let ([dc (send s-admin get-dc)])
(when dc
(let-boxes ([w 0.0]
[h 0.0])
(get-extent dc 0 0 w h)
(send s-admin needs-update
this left-inset top-inset
(+ w (- right-margin right-inset))
(+ h (- bottom-margin bottom-inset))))))))
(def/public (show-border [bool? show])
(unless (eq? with-border? show)
(set! with-border? show)
(request-refresh)))
(def/public (border-visible?)
with-border?)
(def/public (set-margin [exact-nonnegative-integer? lm]
[exact-nonnegative-integer? tm]
[exact-nonnegative-integer? rm]
[exact-nonnegative-integer? bm])
(set! left-margin lm)
(set! top-margin tm)
(set! right-margin rm)
(set! bottom-margin bm)
(resize-me))
(def/public (get-margin [box? lm] [box? tm] [box? rm] [box? bm])
(set-box! lm left-margin)
(set-box! tm top-margin)
(set-box! rm right-margin)
(set-box! bm bottom-margin))
(def/public (set-inset [exact-nonnegative-integer? lm]
[exact-nonnegative-integer? tm]
[exact-nonnegative-integer? rm]
[exact-nonnegative-integer? bm])
(set! left-margin lm)
(set! top-margin tm)
(set! right-margin rm)
(set! bottom-margin bm)
(request-refresh))
(def/public (get-inset [box? lm] [box? tm] [box? rm] [box? bm])
(set-box! lm left-inset)
(set-box! tm top-inset)
(set-box! rm right-inset)
(set-box! bm bottom-inset))
(def/override (get-num-scroll-steps)
(if editor
(send editor num-scroll-lines)
1))
(def/override (find-scroll-step [real? y])
(if editor
(send editor find-scroll-line (- y top-margin))
0))
(def/override (get-scroll-step-offset [exact-integer? n])
(if editor
(+ (send editor scroll-line-location n) top-margin)
0))
(def/override (set-unmodified)
(when editor
(send editor set-modified #f)))
(def/public (do-get-left-margin) left-margin)
(def/public (do-get-right-margin) right-margin)
(def/public (do-get-bottom-margin) bottom-margin)
(def/public (do-get-top-margin) top-margin))
(set-editor-snip%! editor-snip%)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-struct state (dc x y))
(defclass editor-snip-editor-admin% editor-admin%
(init owner)
(define snip owner)
(define state #f)
(super-new)
(define/public (get-snip) snip)
(define/public (with-dc dc x y thunk)
(let* ([other (make-state dc
(+ x (send snip do-get-left-margin))
(+ y (send snip do-get-top-margin)))]
[swap (lambda ()
(let ([s state])
(set! state other)
(set! other s)))])
(dynamic-wind swap thunk swap)))
(def/override (get-dc [maybe-box? [x #f]] [maybe-box? [y #f]])
(let-values ([(xv yv)
(if state
(values (- (state-x state))
(- (state-y state)))
(values 0 0))])
(when x (set-box! x xv))
(when y (set-box! y yv))
(if state
(state-dc state)
(let ([sadmin (send snip get-admin)])
(if sadmin
(send sadmin get-dc)
#f)))))
(def/override (get-view [maybe-box? x] [maybe-box? y]
[maybe-box? w] [maybe-box? h]
[any? [full? #f]])
(let ([sadmin (send snip get-admin)])
(cond
[(not sadmin)
(when x (set-box! x 0.0))
(when y (set-box! y 0.0))
(when w (set-box! w 0.0))
(when h (set-box! h 0.0))]
[full?
(send sadmin get-view x y w h #f)]
[else
(let-boxes ([sx 0.0]
[sy 0.0]
[sw 0.0]
[sh 0.0])
(send sadmin get-view sx sy sw sh snip)
(when x
(set-box! x (max 0.0 (- sx (send snip do-get-left-margin)))))
(when y
(set-box! y (max 0.0 (- sy (send snip do-get-top-margin)))))
(when (or w h)
(if (or (positive? sw) (positive? sh))
;; w and h might be too big due to margins - but
;; they might be small enough already because
;; part of the snip itself is not viewed
(let-boxes ([rw 0.0]
[rh 0.0])
;; we want the internal, non-overridden method:
(send snip do-get-extent (and state (state-dc state)) 0 0 rw rh #f #f #f #f)
;; remember: sx and sy are in snip coordinates
(when w
(let* ([left-margin (max 0.0 (- (send snip do-get-left-margin) sx))]
[sw (- sw left-margin)]
[rw (- rw (send snip do-get-left-margin))]
[right-margin (max 0.0 (- (send snip do-get-right-margin) (- rw sw)))]
[sw (max 0.0 (- sw right-margin))])
(set-box! w sw)))
(when h
(let* ([top-margin (max 0.0 (- (send snip do-get-top-margin) sy))]
[sh (- sh top-margin)]
[rh (- rh (send snip do-get-top-margin))]
[bottom-margin (max 0.0 (- (send snip do-get-bottom-margin) (- rh sh)))]
[sh (max 0.0 (- sh bottom-margin))])
(set-box! h sh))))
(begin
(when w (set-box! w 0.0))
(when h (set-box! h 0.0))))))])))
(def/override (scroll-to [real? localx] [real? localy] [real? w] [real? h] [any? [refresh? #t]]
[(symbol-in start none end) [bias 'none]])
(let ([sadmin (send snip get-admin)])
(and sadmin
(send sadmin scroll-to snip (+ localx (send snip do-get-left-margin))
(+ localy (send snip do-get-top-margin))
w h refresh? bias))))
(def/override (grab-caret [(symbol-in immediate display global) dist])
(let ([sadmin (send snip get-admin)])
(when sadmin
(send sadmin set-caret-owner snip dist))))
(def/override (resized [any? redraw-now])
(let ([sadmin (send snip get-admin)])
(when sadmin
(send sadmin resized snip redraw-now))))
(def/override (needs-update [real? localx] [real? localy]
[nonnegative-real? w] [nonnegative-real? h])
(let ([sadmin (send snip get-admin)])
(when sadmin
(send sadmin needs-update snip
(+ localx (send snip do-get-left-margin))
(+ localy (send snip do-get-top-margin))
w h))))
(def/override (update-cursor)
(let ([sadmin (send snip get-admin)])
(when sadmin
(send sadmin update-cursor))))
(def/override (popup-menu [popup-menu% m] [real? x] [real? y])
(let ([sadmin (send snip get-admin)])
(and sadmin
(send sadmin popup-menu m snip
(+ x (send snip do-get-left-margin))
(+ y (send snip do-get-top-margin))))))
(def/override (delay-refresh?)
(let ([sadmin (send snip get-admin)])
(or (not sadmin)
(and (sadmin . is-a? . standard-snip-admin%)
(send (send sadmin get-editor) refresh-delayed?)))))
(def/override (modified [any? mod?])
(let ([sadmin (send snip get-admin)])
(when sadmin
(send sadmin modified snip mod?)))))
(set-editor-snip-editor-admin%! editor-snip-editor-admin%)
(define editor-snip-editor-admin<%> (class->interface editor-snip-editor-admin%))

1819
collects/mred/private/wxme/editor.ss Normal file
View File

File diff suppressed because it is too large Load Diff

737
collects/mred/private/wxme/keymap.ss Normal file
View File

@ -0,0 +1,737 @@
#lang scheme/base
(require scheme/class
"../syntax.ss"
"wx.ss")
(provide keymap%
map-command-as-meta-key)
(define map-command-as-meta? #f)
(define/top (map-command-as-meta-key [bool? v])
(set! map-command-as-meta? v))
(define (as-meta-key k)
(case (system-type)
[(macosx) (if map-command-as-meta?
k
#f)]
[else k]))
(define (as-cmd-key k)
(case (system-type)
[(macosx) k]
[else #f]))
(define keylist
#hash(("leftbutton" . mouse-left)
("rightbutton" . mouse-right)
("middlebutton" . mouse-middle)
("leftbuttondouble" . mouse-left-double)
("rightbuttondouble" . mouse-right-double)
("middlebuttondouble" . mouse-middle-double)
("leftbuttontriple" . mouse-left-triple)
("rightbuttontriple" . mouse-right-triple)
("middlebuttontriple" . mouse-middle-triple)
("leftbuttonseq" . mouse-left)
("rightbuttonseq" . mouse-right)
("middlebuttonseq" . mouse-middle)
("wheelup" . wheel-up)
("wheeldown" . wheel-down)
("esc" . escape)
("delete" . delete)
("del" . #\rubout)
("insert" . insert)
("ins" . insert)
("add" . add)
("subtract" . subtract)
("multiply" . multiply)
("divide" . divide)
("backspace" . back)
("back" . back)
("return" . #\return)
("enter" . #\return)
("tab" . #\tab)
("space" . #\space)
("right" . right)
("left" . left)
("up" . up)
("down" . down)
("home" . home)
("end" . end)
("pageup" . prior)
("pagedown" . next)
("semicolon" . #\;)
("colon" . #\:)
("numpad0" . numpad0)
("numpad1" . numpad1)
("numpad2" . numpad2)
("numpad3" . numpad3)
("numpad4" . numpad4)
("numpad5" . numpad5)
("numpad6" . numpad6)
("numpad7" . numpad7)
("numpad8" . numpad8)
("numpad9" . numpad9)
("numpadenter" . #\u3)
("f1" . f1)
("f2" . f2)
("f3" . f3)
("f4" . f4)
("f5" . f5)
("f6" . f6)
("f7" . f7)
("f8" . f8)
("f9" . f9)
("f10" . f10)
("f11" . f11)
("f12" . f12)
("f13" . f13)
("f14" . f14)
("f15" . f15)
("f16" . f16)
("f17" . f17)
("f18" . f18)
("f19" . f19)
("f20" . f20)
("f21" . f21)
("f22" . f22)
("f23" . f23)
("f24" . f24)))
(define rev-keylist
(make-immutable-hash
(hash-map keylist (lambda (k v) (cons v k)))))
(define-struct kmfunc (name f))
(define-struct key (code
shift-on?
shift-off?
ctrl-on?
ctrl-off?
alt-on?
alt-off?
meta-on?
meta-off?
cmd-on?
cmd-off?
caps-on?
caps-off?
score
check-other?
fullset?
[fname #:mutable]
isprefix?
seqprefix))
(define-local-member-name
chain-handle-key-event
get-best-score
chain-handle-mouse-event
get-best-mouse-score
cycle-check)
(defclass keymap% object%
(super-new)
(define functions (make-hash))
(define keys (make-hash))
(define prefix #f)
(define prefixed? #f)
(define active-mouse-function #f)
(define grab-key-function #f)
(define grab-mouse-function #f)
(define on-break #f)
(define chain-to null)
(define last-time 0)
(define last-x 0)
(define last-y 0)
(define click-count 0)
(define last-code #f)
(define last-button #f)
(define double-interval (get-double-click-threshold))
(def/public (reset)
(set! prefix #f)
(set! prefixed? #f)
(for-each (lambda (c)
(send c reset))
chain-to))
(def/public (break-sequence)
(set! prefix #f)
(when on-break
(let ([f on-break])
(set! on-break #f)
(f)))
(for-each (lambda (c)
(send c break-sequence))
chain-to))
(def/public (set-break-sequence-callback [(make-procedure 0) f])
(let ([old on-break])
(set! on-break f)
(when old (old))))
(define/private (find-key code other-code alt-code other-alt-code caps-code
shift? ctrl? alt? meta? cmd? caps?
prefix)
(for*/fold ([best-key #f]
[best-score -1])
([findk (in-list (list code other-code alt-code other-alt-code caps-code))]
[key (in-list (hash-ref keys findk null))])
(if (and (or (eqv? (key-code key) code)
(and (key-check-other? key)
(or (eqv? (key-code key) other-code)
(eqv? (key-code key) alt-code)
(eqv? (key-code key) other-alt-code)
(eqv? (key-code key) caps-code))))
(or (and (key-shift-on? key) shift?)
(and (key-shift-off? key) (not shift?))
(and (not (key-shift-on? key)) (not (key-shift-off? key))))
(or (and (key-ctrl-on? key) ctrl?)
(and (key-ctrl-off? key) (not ctrl?))
(and (not (key-ctrl-on? key)) (not (key-ctrl-off? key))))
(or (and (key-alt-on? key) alt?)
(and (key-alt-off? key) (not alt?))
(and (not (key-alt-on? key)) (not (key-alt-off? key))))
(or (and (key-meta-on? key) meta?)
(and (key-meta-off? key) (not meta?))
(and (not (key-meta-on? key)) (not (key-meta-off? key))))
(or (and (key-cmd-on? key) cmd?)
(and (key-cmd-off? key) (not cmd?))
(and (not (key-cmd-on? key)) (not (key-cmd-off? key))))
(or (and (key-caps-on? key) caps?)
(and (key-caps-off? key) (not caps?))
(and (not (key-caps-on? key)) (not (key-caps-off? key))))
(eq? (key-seqprefix key) prefix))
(let ([score (+ (key-score key)
(if (eqv? (key-code key) code)
0
(if (eqv? (key-code key) other-alt-code)
-4
-2)))])
(if (score . > . best-score)
(values key score)
(values best-key best-score)))
(values best-key best-score))))
(define/private (do-map-function code shift ctrl alt meta cmd caps check-other?
fname prev isprefix? fullset?)
;; look for existing key mapping:
(let ([key
(ormap (lambda (key)
(and (eqv? (key-code key) code)
(eq? (key-shift-on? key) (shift . > . 0))
(eq? (key-shift-off? key) (shift . < . 0))
(eq? (key-ctrl-on? key) (ctrl . > . 0))
(eq? (key-ctrl-off? key) (ctrl . < . 0))
(eq? (key-alt-on? key) (alt . > . 0))
(eq? (key-alt-off? key) (alt . < . 0))
(eq? (key-meta-on? key) (meta . > . 0))
(eq? (key-meta-off? key) (meta . < . 0))
(eq? (key-cmd-on? key) (cmd . > . 0))
(eq? (key-cmd-off? key) (cmd . < . 0))
(eq? (key-caps-on? key) (caps . > . 0))
(eq? (key-caps-off? key) (caps . < . 0))
(eq? (key-check-other? key) check-other?)
(eq? (key-seqprefix key) prev)
key))
(hash-ref keys code null))])
(if key
;; Found existing
(if (not (eq? isprefix? (key-isprefix? key)))
;; prefix vs no-prefix mismatch:
(let ([s
(string-append
(if (meta . > . 0) "m:" "")
(if (meta . < . 0) "~m:" "")
(if (cmd . > . 0) "d:" "")
(if (cmd . < . 0) "~d:" "")
(if (alt . > . 0) "a:" "")
(if (alt . < . 0) "~a:" "")
(if (ctrl . > . 0) "c:" "")
(if (ctrl . < . 0) "~c:" "")
(if (shift . > . 0) "s:" "")
(if (shift . < . 0) "~s:" "")
(or (hash-ref rev-keylist code)
(format "~c" code)))])
(error (method-name 'keymap% 'map-function)
"~s is already mapped as a ~aprefix key"
s (if isprefix? "non-" "")))
(begin
(set-key-fname! key (string->immutable-string fname))
key))
;; Create new
(let ([newkey (make-key
code
(shift . > . 0) (shift . < . 0)
(ctrl . > . 0) (ctrl . < . 0)
(alt . > . 0) (alt . < . 0)
(meta . > . 0) (meta . < . 0)
(cmd . > . 0) (cmd . < . 0)
(caps . > . 0) (caps . < . 0)
(+ (if (shift . > . 0) 1 0)
(if (shift . < . 0) 5 0)
(if (ctrl . > . 0) 1 0)
(if (ctrl . < . 0) 5 0)
(if (alt . > . 0) 1 0)
(if (alt . < . 0) 5 0)
(if (meta . > . 0) 1 0)
(if (meta . < . 0) 5 0)
(if (cmd . > . 0) 1 0)
(if (cmd . < . 0) 5 0)
(if (caps . > . 0) 1 0)
(if (caps . < . 0) 5 0)
(if check-other? 6 30))
check-other?
fullset?
(string->immutable-string fname)
isprefix?
prev)])
(hash-set! keys code (cons newkey (hash-ref keys code null)))
newkey))))
(define/private (get-code str)
(let ([code (hash-ref keylist (string-downcase str) #f)])
(if code
(values code (member str '("leftbuttonseq"
"middlebuttonseq"
"rightbuttonseq")))
(if (= 1 (string-length str))
(values (string-ref str 0)
#f)
(values #f #f)))))
(def/public (map-function [string? keys]
[string? fname])
(if (string=? keys "")
(error (method-name 'keymap% 'map-function)
"bad key string: ~e"
keys)
(let loop ([seq (regexp-split #rx";" keys)]
[prev-key #f])
(let ([str (car seq)])
(define (bad-string msg)
(error (method-name 'keymap% 'map-function)
"bad keymap string: ~e~a: ~a"
str
(if (equal? str keys)
""
(format " within ~e" keys))
msg))
(let-values ([(str default-off?)
(if (regexp-match? #rx"^:" str)
(values (substring str 1) #t)
(values str #f))])
(let sloop ([str str]
[downs null]
[ups null]
[others? #f])
(cond
[(regexp-match? #rx"^[?]:" str)
(sloop (substring str 2) downs ups #t)]
[(regexp-match? #rx"^~[SsCcAaMmDdLl]:" str)
(let ([c (char-downcase (string-ref str 1))])
(if (memv c downs)
(bad-string (format "inconsistent ~a: modifier state" c))
(sloop (substring str 3) downs (cons c ups) others?)))]
[(regexp-match? #rx"^[SsCcAaMmDdLl]:" str)
(let ([c (char-downcase (string-ref str 0))])
(if (memv c ups)
(bad-string (format "inconsistent ~a: modifier state" c))
(sloop (substring str 2) (cons c downs) ups others?)))]
[else
(let-values ([(code fullset?) (get-code str)])
(if (not code)
(bad-string "unrecognized key name")
(let-values ([(downs code)
(if (and (char? code)
((char->integer code) . > . 0)
((char->integer code) . < . 127)
(char-alphabetic? code))
(cond
[(memq #\s downs)
(if (or (and (eq? (system-type) 'macosx)
(not (memq #\m downs))
(not (memq #\d downs)))
(and (eq? (system-type) 'windows)
(or (not (memq #\c downs))
(memq #\m downs))))
(values downs (char-upcase code))
(values downs code))]
[(char-upper-case? code)
(values (cons #\s downs) code)]
[else
(values downs code)])
(values downs code))])
(let ([newkey
(let ([modval (lambda (c)
(cond
[(memq c downs) 1]
[(memq c ups) -1]
[else (if default-off? -1 0)]))])
(do-map-function code
(modval #\s)
(modval #\c)
(modval #\a)
(modval #\m)
(modval #\d)
(modval #\l)
others?
fname
prev-key
(not (null? (cdr seq)))
fullset?))])
(if (null? (cdr seq))
(void)
(loop (cdr seq) newkey))))))])))))))
(define/private (handle-event code other-code alt-code other-alt-code caps-code
shift? ctrl? alt? meta? cmd? caps?
score)
(let-values ([(key found-score)
(find-key code other-code alt-code other-alt-code caps-code
shift? ctrl? alt? meta? cmd? caps? prefix)])
(set! prefix #f)
(if (and key (found-score . >= . score))
(if (key-isprefix? key)
(begin
(set! prefix key)
(values #t #f #f))
(values #t
(key-fname key)
(key-fullset? key)))
(values #f #f #f))))
(define/public (get-best-score code other-code alt-code other-alt-code caps-code
shift? ctrl? alt? meta? cmd? caps?)
(let-values ([(key score)
(find-key code other-code alt-code other-alt-code caps-code
shift? ctrl? alt? meta? cmd? caps? prefix)])
(for/fold ([s (if key score -1)])
([c (in-list chain-to)])
(max s
(send c get-best-score code other-code alt-code other-alt-code caps-code
shift? ctrl? alt? meta? cmd? caps?)))))
(def/public (set-grab-key-function [(make-procedure 4) grab])
(set! grab-key-function grab))
(def/public (remove-grab-key-function)
(set! grab-key-function #f))
(def/public (handle-key-event [any? obj] [key-event% event])
(let ([code (send event get-key-code)])
(or (eq? code 'shift)
(eq? code 'control)
(eq? code 'release)
(let ([score (get-best-score
code
(send event get-other-shift-key-code)
(send event get-other-altgr-key-code)
(send event get-other-shift-altgr-key-code)
(send event get-other-caps-key-code)
(send event get-shift-down)
(send event get-control-down)
(send event get-alt-down)
(as-meta-key (send event get-meta-down))
(as-cmd-key (send event get-meta-down))
(send event get-caps-down))])
(let ([was-prefixed? prefixed?])
(let* ([r (chain-handle-key-event obj event #f prefixed? score)]
[r (if (and (zero? r)
was-prefixed?)
(begin
(reset)
;; try again without prefix:
(chain-handle-key-event obj event #f #f score))
r)])
(when (r . >= . 0)
(reset))
(not (zero? r))))))))
(define/private (other-handle-key-event obj event grab try-prefixed? score)
(for/fold ([r 0])
([c (in-list chain-to)]
#:when (r . <= . 0))
(let ([r (send c chain-handle-key-event obj event grab try-prefixed? score)])
(if (r . > . 0)
(begin
(reset)
r)
r))))
(define/public (chain-handle-key-event obj event grab only-prefixed? score)
;; results: 0 = no match, 1 = match, -1 = matched prefix
(set! last-time (send event get-time-stamp))
(set! last-button #f)
(let ([grab (or grab-key-function
grab)])
(if (and only-prefixed? (not prefixed?))
0
(let ([sub-result (other-handle-key-event obj event grab only-prefixed? score)])
(if (sub-result . > . 0)
sub-result
(let-values ([(h? fname fullset?)
(handle-event (send event get-key-code)
(send event get-other-shift-key-code)
(send event get-other-altgr-key-code)
(send event get-other-shift-altgr-key-code)
(send event get-other-caps-key-code)
(send event get-shift-down)
(send event get-control-down)
(send event get-alt-down)
(as-meta-key (send event get-meta-down))
(as-cmd-key (send event get-meta-down))
(send event get-caps-down)
score)])
(if h?
(if fname
(begin
(reset)
(if (and grab
(grab fname this obj event))
1
(if (call-function fname obj event)
1
0)))
(if prefix
(begin
(set! prefixed? #t)
-1)
;; shouldn't get here
0))
(let ([result
(if (sub-result . < . 0)
(begin
(set! prefixed? #t)
-1)
0)])
(if (and (zero? result)
grab-key-function
(grab-key-function #f this obj event))
1
result)))))))))
(def/public (set-grab-mouse-function [(make-procedure 4) grab])
(set! grab-mouse-function grab))
(def/public (remove-grab-mouse-function)
(set! grab-mouse-function #f))
(define/private (adjust-button-code code click-count)
(case click-count
[(0) code]
[(1) (case code
[(mouse-right) 'mouse-right-double]
[(mouse-left) 'mouse-left-double]
[(mouse-middle) 'mouse-middle-double])]
[else (case code
[(mouse-right) 'mouse-right-triple]
[(mouse-left) 'mouse-left-triple]
[(mouse-middle) 'mouse-middle-triple])]))
(def/public (handle-mouse-event [any? obj][mouse-event% event])
(let ([score (get-best-mouse-score event)])
(not (zero? (chain-handle-mouse-event obj event #f 0 score)))))
(define/public (get-best-mouse-score event)
(cond
[(not (send event button-down?))
(if active-mouse-function
100
(or (ormap (lambda (c)
(and (not (zero? (send c get-best-mouse-score event)))
100))
chain-to)
-1))]
[else
(let ([code (cond
[(send event get-right-down) 'mouse-right]
[(send event get-left-down) 'mouse-left]
[(send event get-middle-down) 'mouse-middle]
[else #f])])
(if (not code)
-1
(let ([code
(if (and (eq? code last-button)
(= (send event get-x) last-x)
(= (send event get-y) last-y)
((abs (- (send event get-time-stamp) last-time)) . < . double-interval))
(adjust-button-code code click-count)
code)])
(get-best-score code #f #f #f #f
(send event get-shift-down)
(send event get-control-down)
(send event get-alt-down)
(as-meta-key (send event get-meta-down))
(as-cmd-key (send event get-meta-down))
(send event get-caps-down)))))]))
(define/private (other-handle-mouse-event obj event grab try-state score)
(for/fold ([result 0])
([c (in-list chain-to)]
#:when (result . <= . 0))
(let ([r (send c chain-handle-mouse-event obj event grab try-state score)])
(cond
[(r . > . 0)
(reset)
r]
[(zero? r) result]
[else r]))))
(define/public (chain-handle-mouse-event obj event grab try-state score)
(let ([grab (or grab-mouse-function grab)])
(define (step1)
(cond
[(and (not prefix)
(try-state . >= . 0))
(let ([r (other-handle-mouse-event obj event grab 1 score)])
(cond
[(r . > . 0) r]
[(try-state . > . 0) r]
[else (step2 -1)]))]
[(and prefix (try-state . < . 0))
(other-handle-mouse-event obj event grab -1 score)]
[else (step2 try-state)]))
(define (step2 try-state)
(cond
[(not (send event button-down?))
(when (and (not (send event dragging?))
(not (send event button-up?)))
;; we must have missed the button-up
(set! active-mouse-function #f))
(if (not active-mouse-function)
(other-handle-mouse-event obj event grab -1 score)
(let ([v (if (and grab
(grab active-mouse-function this obj event))
1
(if (call-function active-mouse-function obj event)
1
0))])
(when (send event button-up?)
(set! active-mouse-function #f))
v))]
[else
(let ([code (cond
[(send event get-right-down) 'mouse-right]
[(send event get-left-down) 'mouse-left]
[(send event get-middle-down) 'mouse-middle]
[else #f])])
(if (not code)
0 ;; FIXME: should we call grab here?
(let ([orig-code code]
[code
(if (and (eq? code last-button)
(= (send event get-x) last-x)
(= (send event get-y) last-y))
(if ((abs (- (send event get-time-stamp) last-time)) . < . double-interval)
(begin0
(adjust-button-code code click-count)
(set! click-count (add1 click-count)))
(begin
(set! click-count 1)
code))
(begin
(set! last-button code)
(set! click-count 1)
code))])
(set! last-time (send event get-time-stamp))
(set! last-x (send event get-x))
(set! last-y (send event get-y))
(let loop ([code code])
(let-values ([(h? fname fullset?) (handle-event code
#f #f #f #f
(send event get-shift-down)
(send event get-control-down)
(send event get-alt-down)
(as-meta-key (send event get-meta-down))
(as-cmd-key (send event get-meta-down))
(send event get-caps-down)
score)])
(cond
[(and h? fname)
(reset)
(when fullset?
(set! active-mouse-function fname))
(cond
[(and grab (grab fname this obj event)) 1]
[(call-function fname obj event) 1]
[else 0])]
[h?
(let ([r (other-handle-mouse-event obj event grab try-state score)])
(if (r . > . 0)
r
-1))]
[else
(set! last-code code)
(if (not (eqv? last-code orig-code))
(loop orig-code)
(let ([result (other-handle-mouse-event obj event grab try-state score)])
(if (and (zero? result)
grab-mouse-function
(grab-mouse-function #f this obj event))
1
result)))]))))))]))
(step1)))
(def/public (add-function [string? name] [(make-procedure 2) f])
(hash-set! functions
(string->immutable-string name)
f))
(def/public (call-function [string? name] [any? obj] [event% event] [any? [try-chained? #f]])
(let ([f (hash-ref functions name #f)])
(cond
[f
(f obj event)
#t]
[try-chained?
(ormap (lambda (c)
(send c call-function name obj event #t))
chain-to)]
[else
(error 'keymap "no function ~e" name)])))
(def/public (get-double-click-interval)
double-interval)
(def/public (set-double-click-interval [exact-positive-integer? d])
(set! double-interval d))
(define/public (cycle-check km)
(ormap (lambda (c)
(or (eq? km c)
(send c cycle-check km)))
chain-to))
(def/public (chain-to-keymap [keymap% km] [any? prefix?])
(unless (or (eq? km this)
(cycle-check km)
(send km cycle-check this))
(set! chain-to (if prefix?
(cons km chain-to)
(append chain-to (list km))))))
(def/public (remove-chained-keymap [keymap% km])
(set! chain-to (remq km chain-to))))

1192
collects/mred/private/wxme/mline.ss Normal file
View File

File diff suppressed because it is too large Load Diff

2122
collects/mred/private/wxme/pasteboard.ss Normal file
View File

File diff suppressed because it is too large Load Diff

140
collects/mred/private/wxme/private.ss Normal file
View File

@ -0,0 +1,140 @@
#lang scheme/base
(require scheme/class)
(provide (all-defined-out))
;; snip% and editor%
(define-local-member-name
s-admin)
;; snip%
(define-local-member-name
s-prev set-s-prev
s-next set-s-next
s-count
s-style set-s-style
s-line set-s-line
s-snipclass set-s-snipclass
s-flags set-s-flags
s-dtext get-s-dtext
s-buffer get-s-buffer
str-w set-str-w
s-set-flags
do-copy-to)
;; string-snip%
(define-local-member-name
insert-with-offset)
;; snip-class%
(define-local-member-name
get-s-required?)
;; editor-data%
(define-local-member-name
get-s-dataclass
get-s-next)
;; standard-snip-class-list%, editor-data-class-list%
(define-local-member-name
reset-header-flags
find-by-map-position)
;; editor%
(define-local-member-name
s-offscreen
s-custom-cursor
s-custom-cursor-overrides?
s-keymap
s-style-list
get-s-style-list
s-user-locked?
s-modified?
s-noundomode
s-caret-snip
s-inactive-caret-threshold
s-filename
s-need-on-display-size?
really-can-edit?
copy-out-x-selection
own-x-selection
do-own-x-selection
perform-undo-list
copy-ring-next
begin-copy-buffer
end-copy-buffer
free-old-copies
install-copy-buffer
add-undo-rec
read-snips-from-file
admin-scroll-to
do-buffer-paste
insert-paste-snip
insert-paste-string
paste-region-data
setting-admin
init-new-admin
do-read-insert
do-set-caret-owner
do-own-caret
s-start-intercept
s-end-intercept
wait-sequence-lock
begin-sequence-lock
end-sequence-lock
check-flow
get-printing
is-printing?
do-begin-print
do-end-print
do-has-print-page?)
;; text%
(define-local-member-name
get-s-line-spacing
get-s-last-snip
get-s-total-width
get-s-total-height
refresh-box
add-back-clickback
do-insert-snips)
;; editor-admin%
(define-local-member-name
get-s-standard
set-s-standard)
;; editor-canvas-editor-admin%
(define-local-member-name
do-get-canvas)
;; editor-stream%
(define-local-member-name
get-sl
get-dl
set-sl
set-dl
add-sl
add-dl
set-s-sll
get-s-sll
get-s-scl
get-s-bdl
get-s-style-count
set-s-style-count
do-reading-version
do-map-position
do-get-header-flag
do-set-header-flag)
;; editor-stream-in%
(define-local-member-name
set-s-read-format
get-s-read-format
set-s-read-version
get-wxme-version)
;; editor-snip%
(define-local-member-name
do-set-graphics)

147
collects/mred/private/wxme/snip-admin.ss Normal file
View File

@ -0,0 +1,147 @@
#lang scheme/base
(require scheme/class
"../syntax.ss"
"snip.ss"
(only-in "cycle.ss"
set-snip-admin%!
popup-menu%)
"wx.ss")
(provide snip-admin%
standard-snip-admin%)
(defclass snip-admin% object%
(super-new)
(def/public (get-editor) #f)
(def/public (get-dc) #f)
(def/public (get-view-size [maybe-box? w] [maybe-box? h])
#f)
(def/public (get-view [maybe-box? x] [maybe-box? y] [maybe-box? w] [maybe-box? h]
[(make-or-false snip%) snip])
#f)
(def/public (scroll-to [snip% s]
[real? x] [real? y]
[nonnegative-real? w] [nonnegative-real? h]
[any? refresh?]
[(symbol-in start end none) [bias 'none]])
#f)
(def/public (set-caret-owner [snip% s] [(symbol-in imeditorte display global) dist])
(void))
(def/public (resized [snip% s] [any? redraw?]) (void))
(def/public (recounted [snip% s] [any? redraw?]) (void))
(def/public (needs-update [snip% s] [real? x] [real? y]
[nonnegative-real? w] [nonnegative-real? h])
(void))
(def/public (release-snip [snip% s]) #f)
(def/public (update-cursor) (void))
(def/public (popup-menu [popup-menu% p][snip% snip][real? x][real? y])
#f)
(def/public (modified [snip% s] [any? modified?])
(void)))
(set-snip-admin%! snip-admin%)
(defclass standard-snip-admin% snip-admin%
(init-field editor)
(super-new)
(def/override (get-editor) editor)
(def/override (get-dc) (send editor get-dc))
(def/override (get-view-size [maybe-box? w] [maybe-box? h])
(get-view #f #f w h #f))
(def/override (get-view [maybe-box? x] [maybe-box? y] [maybe-box? w] [maybe-box? h]
[(make-or-false snip%) snip])
(let ([admin (send editor get-admin)]
[zeros (lambda ()
(when x (set-box! x 0.0))
(when y (set-box! y 0.0))
(when w (set-box! w 0.0))
(when h (set-box! h 0.0)))])
(if snip
(if admin
(let-boxes ([mx 0.0] [my 0.0]
[mw 0.0] [mh 0.0])
(send admin get-view mx my mw mh #f)
(let ([mb (+ my mh)]
[mr (+ mx mw)])
(let-boxes ([ok? #f]
[sl 0.0]
[st 0.0])
(set-box! ok? (send editor get-snip-location snip sl st #f))
(if ok?
(let-boxes ([sr 0.0][sb 0.0])
(send editor get-snip-location snip sr sb #t)
(let ([l (max mx sl)]
[t (max my st)]
[r (min mr sr)]
[b (min mb sb)])
(when x (set-box! x (- l sl)))
(when y (set-box! y (- t st)))
(when w (set-box! w (max 0 (- r l))))
(when h (set-box! h (max 0 (- b t))))))
(zeros)))))
(zeros))
(if admin
(send admin get-view x y w h #t)
(zeros)))))
(def/override (scroll-to [snip% s]
[real? localx] [real? localy]
[nonnegative-real? w] [nonnegative-real? h]
[any? [refresh? #t]]
[(symbol-in start end none) [bias 'none]])
(and (eq? (send s get-admin) this)
(send editor scroll-to s localx localy w h refresh? bias)))
(def/override (set-caret-owner [snip% s] [(symbol-in imeditorte display global) dist])
(when (eq? (send s get-admin) this)
(send editor set-caret-owner s dist)))
(def/override (resized [snip% s] [any? redraw?])
(when (eq? (send s get-admin) this)
(send editor resized s redraw?)))
(def/override (recounted [snip% s] [any? redraw?])
(when (eq? (send s get-admin) this)
(send editor recounted s redraw?)))
(def/override (needs-update [snip% s] [real? localx] [real? localy]
[nonnegative-real? w] [nonnegative-real? h])
(when (eq? (send s get-admin) this)
(send editor needs-update s localx localy w h)))
(def/override (release-snip [snip% s])
(and (eq? (send s get-admin) this)
(send editor release-snip s)))
(def/override (update-cursor)
(let ([admin (send editor get-admin)])
(when admin
(send admin update-cursor))))
(def/override (popup-menu [popup-menu% m][snip% snip][real? x][real? y])
(let ([admin (send editor get-admin)])
(and admin
(let-boxes ([sl 0.0]
[st 0.0]
[ok? #f])
(set-box! ok? (send editor get-snip-location snip sl st #f))
(and ok?
(send admin popup-menu m (+ x sl) (+ y st)))))))
(def/override (modified [snip% s] [any? modified?])
(when (eq? (send s get-admin) this)
(send editor on-snip-modified s modified?))))

92
collects/mred/private/wxme/snip-flags.ss Normal file
View File

@ -0,0 +1,92 @@
#lang scheme/base
(require (for-syntax scheme/base))
(provide (all-defined-out))
(define NO-FLAGS 0)
(define IS-TEXT #x1)
(define CAN-APPEND #x2)
(define INVISIBLE #x4)
(define NEWLINE #x8) ;; Soft newline, typically inserted by text%
(define HARD-NEWLINE #x10) ;; => Snip must be follwed by newline
(define HANDLES-EVENTS #x20)
(define WIDTH-DEPENDS-ON-X #x40)
(define HEIGHT-DEPENDS-ON-Y #x80)
(define WIDTH-DEPENDS-ON-Y #x100)
(define HEIGHT-DEPENDS-ON-X #x200)
(define ANCHORED #x400)
(define USES-BUFFER-PATH #x800)
(define CAN-SPLIT #x1000) ;; safety feature
(define OWNED #x2000)
(define CAN-DISOWN #x4000)
(define-syntax-rule (has-flag? flags flag)
(not (zero? (bitwise-and flags flag))))
(define-syntax-rule (add-flag flags flag)
(bitwise-ior flags flag))
(define-syntax-rule (remove-flag flags flag)
(bitwise-and flags (bitwise-not flag)))
(define (copy-flag from to flag)
(if (has-flag? from flag)
(add-flag to flag)
(remove-flag to flag)))
(define (flags->symbols flag)
(let-syntax ([syms
(lambda (stx)
(syntax-case stx ()
[(_ id ...)
(with-syntax ([(sym ...)
(map (lambda (s)
(string->symbol
(string-downcase
(symbol->string
(syntax-e s)))))
(syntax->list #'(id ...)))])
#'(append
(if (has-flag? flag id)
'(sym)
null)
...))]))])
(syms IS-TEXT
CAN-APPEND
INVISIBLE
NEWLINE
HARD-NEWLINE
HANDLES-EVENTS
WIDTH-DEPENDS-ON-X
HEIGHT-DEPENDS-ON-Y
WIDTH-DEPENDS-ON-Y
HEIGHT-DEPENDS-ON-X)))
(define (symbols->flags symbols)
(let-syntax ([syms
(lambda (stx)
(syntax-case stx ()
[(_ id ...)
(with-syntax ([(sym ...)
(map (lambda (s)
(string->symbol
(string-downcase
(symbol->string
(syntax-e s)))))
(syntax->list #'(id ...)))])
#'(bitwise-ior
(if (memq 'sym symbols)
id
0)
...))]))])
(syms IS-TEXT
CAN-APPEND
INVISIBLE
NEWLINE
HARD-NEWLINE
HANDLES-EVENTS
WIDTH-DEPENDS-ON-X
HEIGHT-DEPENDS-ON-Y
WIDTH-DEPENDS-ON-Y
HEIGHT-DEPENDS-ON-X)))

1488
collects/mred/private/wxme/snip.ss Normal file
View File

File diff suppressed because it is too large Load Diff

761
collects/mred/private/wxme/stream.ss Normal file
View File

@ -0,0 +1,761 @@
#lang scheme/base
(require scheme/class
"../syntax.ss"
"private.ss"
"snip.ss"
(only-in "cycle.ss"
set-editor-stream-in%!
set-editor-stream-out%!))
(provide editor-stream-in%
editor-stream-out%
editor-stream-in-base%
editor-stream-in-bytes-base%
editor-stream-in-file-base%
editor-stream-out-base%
editor-stream-out-bytes-base%
editor-stream-out-file-base%)
;; ----------------------------------------
(defclass editor-stream% object%
(super-new)
(define scl (get-the-snip-class-list))
(define bdl (get-the-editor-data-class-list))
(define/public (get-s-scl) scl)
(define/public (get-s-bdl) bdl)
(define sl null)
(define dl null)
(define/public (get-sl) sl)
(define/public (get-dl) dl)
(define/public (set-sl n) (set! sl n))
(define/public (set-dl n) (set! dl n))
(define/public (add-sl v) (set! sl (cons v sl)))
(define/public (add-dl v) (set! dl (cons v dl)))
(define sll null)
(define style-count 0)
(define/public (get-s-sll) sll)
(define/public (set-s-sll v) (set! sll v))
(define/public (get-s-style-count) style-count)
(define/public (set-s-style-count v) (set! style-count v))
(define/public (do-reading-version sclass)
(or (ormap (lambda (scl)
(and (eq? (snip-class-link-c scl) sclass)
(snip-class-link-reading-version scl)))
sl)
;; Class didn't show up in the header?
;; Assume we're reading the current version.
(send sclass get-version)))
(define/public (do-map-position sclass-or-dclass)
(if (sclass-or-dclass . is-a? . snip-class%)
(or (ormap (lambda (scl)
(and (eq? (snip-class-link-c scl) sclass-or-dclass)
(snip-class-link-map-position scl)))
sl)
-1)
(or (ormap (lambda (dcl)
(and (eq? (editor-data-class-link-c dcl) sclass-or-dclass)
(editor-data-class-link-map-position dcl)))
dl)
-1)))
(define/public (do-get-header-flag sclass)
(or (ormap (lambda (scl)
(and (eq? (snip-class-link-c scl) sclass)
(snip-class-link-header-flag scl)))
sl)
0))
(define/public (do-set-header-flag sclass)
(ormap (lambda (scl)
(and (eq? (snip-class-link-c scl) sclass)
(begin
(set-snip-class-link-header-flag! scl #t)
#t)))
sl)
(void)))
;; ----------------------------------------
(defclass editor-stream-in-base% object%
(super-new)
(def/public (tell) 0)
(def/public (seek [exact-nonnegative-integer? i]) (void))
(def/public (skip [exact-nonnegative-integer? i]) (void))
(def/public (bad?) #t)
(def/public (read [vector? v])
(let ([s (make-bytes (vector-length v))])
(let ([n (read-bytes s)])
(for ([i (in-range n)])
(vector-set! v i (integer->char (bytes-ref s i))))
n)))
(def/public (read-bytes [bytes? v]
[exact-nonnegative-integer? [start 0]]
[exact-nonnegative-integer? [end (bytes-length v)]])
0))
(defclass editor-stream-out-base% object%
(super-new)
(def/public (tell) 0)
(def/public (seek [exact-nonnegative-integer? i]) (void))
(def/public (skip [exact-nonnegative-integer? i]) (void))
(def/public (bad?) #t)
(def/public (write [(make-list char?) v])
(write-bytes (string->bytes/latin-1 (list->string v) (char->integer #\?))))
(def/public (write-bytes [bytes? v]
[exact-nonnegative-integer? [start 0]]
[exact-nonnegative-integer? [end (bytes-length v)]])
(void)))
;; ----------------------------------------
(defclass editor-stream-in-port-base% editor-stream-in-base%
(init-field port)
(super-new)
(def/override (tell)
(file-position port))
(def/override (seek [exact-nonnegative-integer? i])
(file-position port i))
(def/override (skip [exact-nonnegative-integer? i])
(file-position port (+ i (file-position port))))
(def/override (bad?) #f)
(def/override (read-bytes [bytes? v]
[exact-nonnegative-integer? [start 0]]
[exact-nonnegative-integer? [end (bytes-length v)]])
(let ([r (read-bytes! v port start end)])
(if (eof-object? r)
0
r))))
(defclass editor-stream-in-file-base% editor-stream-in-port-base%
(super-new))
(defclass editor-stream-in-bytes-base% editor-stream-in-port-base%
(init s)
(super-new [port (open-input-bytes s)]))
;; ----------------------------------------
(define write-bytes-proc write-bytes)
(defclass editor-stream-out-port-base% editor-stream-out-base%
(init-field port)
(super-new)
(def/override (tell)
(file-position port))
(def/override (seek [exact-nonnegative-integer? i])
(file-position port i))
(def/override (skip [exact-nonnegative-integer? i])
(file-position port (+ i (file-position port))))
(def/override (bad?) #f)
(def/override (write-bytes [bytes? v]
[exact-nonnegative-integer? [start 0]]
[exact-nonnegative-integer? [end (bytes-length v)]])
(write-bytes-proc v port start end)))
(defclass editor-stream-out-file-base% editor-stream-out-port-base%
(super-new))
(defclass editor-stream-out-bytes-base% editor-stream-out-port-base%
(define s (open-output-bytes))
(super-new [port s])
(def/public (get-bytes)
(get-output-bytes s)))
;; ----------------------------------------
(defclass editor-stream-in% editor-stream%
(init-rest args)
(define f
(case-args
args
[([editor-stream-in-base% base]) base]
(init-name 'editor-stream-in%)))
(define boundaries null)
(define is-bad? #f)
(define items 0)
(define pos-map (make-hash))
(define read-version 8)
(define s-read-version #"08")
(super-new)
(define/public (set-s-read-version bstr)
(set! s-read-version bstr)
(set! read-version (or (string->number (bytes->string/utf-8 bstr)) 0)))
(define/public (get-wxme-version) read-version)
(define s-read-format #"WXME")
(define/public (set-s-read-format bstr)
(set! s-read-format bstr))
(define/public (get-s-read-format)
s-read-format)
(define/private (do-skip-whitespace)
(define (bad!) (set! is-bad? #t) 0)
(if is-bad?
0
(let ([s (make-bytes 1)])
(let loop ([prev-byte 0])
(if (not (= 1 (send f read-bytes s)))
(bad!)
(let ([b (bytes-ref s 0)])
(case (integer->char b)
[(#\#)
(let ([pos (send f tell)])
(if (and (= 1 (send f read-bytes s))
(= (bytes-ref s 0) (char->integer #\|)))
;; skip to end of comment
(let cloop ([saw-bar? #f]
[saw-hash? #f]
[nesting 0])
(if (not (= 1 (send f read-bytes s)))
(bad!)
(cond
[(and saw-bar? (= (bytes-ref s 0) (char->integer #\#)))
(if (zero? nesting)
(loop (char->integer #\space))
(cloop #f #f (sub1 nesting)))]
[(and saw-hash? (= (bytes-ref s 0) (char->integer #\|)))
(cloop #t #f (add1 nesting))]
[else (cloop (= (bytes-ref s 0) (char->integer #\|))
(= (bytes-ref s 0) (char->integer #\#))
nesting)])))
(begin
(send f seek pos)
(char->integer #\#))))]
[(#\;)
;; skip to end of comment
(let cloop ()
(if (not (= 1 (send f read-bytes s)))
(bad!)
(if (or (= (bytes-ref s 0) (char->integer #\newline))
(= (bytes-ref s 0) (char->integer #\return)))
(loop (char->integer #\space))
(cloop))))]
[else
(if (char-whitespace? (integer->char b))
(loop b)
b)])))))))
(define/private (skip-whitespace [buf #f])
(let ([c (do-skip-whitespace)])
(when buf
(bytes-set! buf 0 c))
c))
(define/private (is-delim? b)
(cond
[(char-whitespace? (integer->char b)) #t]
[(= b (char->integer #\#))
(let ([pos (send f tell)]
[s (make-bytes 1)])
(send f read-bytes s)
(let ([d? (= (bytes-ref s 0) (char->integer #\|))])
(send f seek (if d? (sub1 pos) pos))
d?))]
[(= b (char->integer #\;))
(send f seek (sub1 (send f tell)))
#t]
[else #f]))
(define/private (get-number get-exact?)
(let ([c0 (skip-whitespace)])
(if (check-boundary)
(if get-exact? 0 0.0)
(let* ([s (make-bytes 1)]
[l (cons (integer->char c0)
(let loop ([counter 50])
(if (zero? counter)
null
(if (= 1 (send f read-bytes s))
(let ([s (bytes-ref s 0)])
(if (is-delim? s)
null
(cons (integer->char s)
(loop (sub1 counter)))))
null))))])
(inc-item-count)
(let ([n (string->number (list->string l))])
(cond
[(or (not n)
(not (real? n))
(and get-exact? (not (exact-integer? n))))
(set! is-bad? #t)
(if get-exact? 0 0.0)]
[get-exact? n]
[else
(exact->inexact n)]))))))
(define/private (get-a-string limit recur?)
(let* ([orig-len (if recur?
(if (limit . < . 16)
limit
16)
(get-exact))]
[buf (make-bytes 32)]
[fail (lambda ()
(set! is-bad? #t)
#"")])
(if recur?
(bytes-set! buf 0 (char->integer #\#))
(begin
(skip-whitespace buf)
(when is-bad?
(bytes-set! buf 0 0))))
(cond
[(= (bytes-ref buf 0) (char->integer #\#))
(if (and (= (send f read-bytes buf 1 2) 1)
(= (bytes-ref buf 1) (char->integer #\")))
(let-values ([(si s) (make-pipe)]
[(tmp) (make-bytes (+ orig-len 2))])
(display "#\"" s)
(let loop ([get-amt (add1 orig-len)]) ;; add 1 for closing quote
(let ([got-amt (send f read-bytes tmp 0 get-amt)])
(if (not (= got-amt get-amt))
(fail)
(begin
(write-bytes tmp s 0 got-amt)
(let ([done?
(let loop ([i 0])
(cond
[(= i got-amt) #f]
[(= (bytes-ref tmp i) (char->integer #\")) #t]
[(= (bytes-ref tmp i) (char->integer #\\))
(if (= (add1 i) got-amt)
;; need to read escaped character
(if (not (= (send f read-bytes tmp got-amt (add1 got-amt)) 1))
(fail)
(begin
(write-bytes tmp s got-amt (add1 got-amt))
#f))
(loop (+ i 2)))]
[else (loop (+ i 1))]))])
(if done?
(begin
(close-output-port s)
(unless recur? (inc-item-count))
(let ([s (with-handlers ([exn:fail:read? (lambda (x) #f)])
(read si))])
(if (or (not s)
(not (eof-object? (read-byte si))))
(fail)
(if (if recur?
((bytes-length s) . <= . limit)
(= (bytes-length s) orig-len))
s
(fail)))))
(loop 1))))))))
(fail))]
[(and (not recur?) (= (bytes-ref buf 0) (char->integer #\()))
;; read a sequence of strings
(let loop ([accum null]
[left-to-get orig-len])
(skip-whitespace buf)
(if (or is-bad?
(negative? left-to-get))
(fail)
(cond
[(= (bytes-ref buf 0) (char->integer #\)))
;; got all byte strings
(if (zero? left-to-get)
(begin
(inc-item-count)
(apply bytes-append (reverse accum)))
(fail))]
[(= (bytes-ref buf 0) (char->integer #\#))
(let ([v (get-a-string left-to-get #t)])
(if is-bad?
(fail)
(loop (cons v accum)
(- left-to-get (bytes-length v)))))]
[else (fail)])))]
[else (fail)])))
(define/private (inc-item-count)
(set! items (add1 items))
(tell))
(define/private (skip-one recur?)
(let ([buf (make-bytes 1)]
[fail (lambda () (set! is-bad? #t) (void))]
[success (lambda () (unless recur? (inc-item-count)))])
(if recur?
(bytes-set! buf 0 (char->integer #\#))
(skip-whitespace buf))
(unless is-bad?
(cond
[(= (bytes-ref buf 0) (char->integer #\#))
;; byte string
(if (and (= 1 (send f read-bytes buf))
(= (bytes-ref buf 0) (char->integer #\")))
(let loop ()
(if (= 1 (send f read-bytes buf))
(cond
[(= (bytes-ref buf 0) (char->integer #\\))
(if (= 1 (send f read-bytes buf))
(loop)
(fail))]
[(= (bytes-ref buf 0) (char->integer #\"))
(success)]
[else (loop)])
(fail)))
(fail))]
[(= (bytes-ref buf 0) (char->integer #\)))
;; list of byte strings
(let loop ()
(if is-bad?
(fail)
(if (not (= (send f read-bytes buf) 1))
(fail)
(if (is-delim? (bytes-ref buf 0))
(cond
[(= (bytes-ref buf 0) (char->integer #\)))
(success)]
[(= (bytes-ref buf 0) (char->integer #\#))
(skip-one #t)
(loop)]
[else (fail)])
(loop)))))]
[else
;; number -- skip anything delimited
(let loop ()
(if (not (= (send f read-bytes buf) 1))
(fail)
(if (is-delim? (bytes-ref buf 0))
(success)
(loop))))]))))
(def/public (get-fixed [box? vb])
(let ([v (if (check-boundary)
0
(if (read-version . < . 8)
(let ([buf (make-bytes 4)])
(send f read-bytes buf)
(integer-bytes->integer
buf
#t
(if (= read-version 1)
(system-big-endian?)
#t)))
(get-exact)))])
(set-box! vb v)))
#|
integer format specified by first byte:
bit 8: 0 - read 7-bit (positive) number
bit 8: 1 - ...
bit 7: 0 - read abother byte for 15-bit (positive) number
bit 7: 1 - negative and long numbers...
bit 1: 1 - read another 8-bit (signed) number
bit 1: 0 - ...
bit 2: 1 - read another 16-bit (signed) number
bit 2: 0 - read another 32-bit (signed) number
|#
(def/public (get-exact)
(if (check-boundary)
0
(if (read-version . < . 8)
(let ([buf (make-bytes 4)]
[fail (lambda () (set! is-bad? #t) 0)])
(if (not (= 1 (send f read-bytes buf 0 1)))
(fail)
(let ([b (bytes-ref buf 0)])
(if (positive? (bitwise-and b #x80))
(if (positive? (bitwise-and b #x40))
(cond
[(positive? (bitwise-and b #x01))
(if (= 1 (send f read-bytes buf 0 1))
(let ([b (bytes-ref buf 0)])
(if (b . > . 127)
(- b 256)
b))
(fail))]
[(positive? (bitwise-and b #x02))
(if (= 2 (send f read-bytes buf 0 2))
(integer-bytes->integer b #t #t)
(fail))]
[else
(if (= 4 (send f read-bytes buf 0 2))
(integer-bytes->integer buf #t #t)
(fail))])
(if (= 1 (send f read-bytes buf 0 1))
(+ (arithmetic-shift (bitwise-and b #x3F) 8)
(bytes-ref buf 0))
(fail)))
b))))
(get-number #t))))
(def/public (get-inexact)
(if (check-boundary)
0
(if (read-version . < . 8)
(let ([buf (make-bytes 8)])
(send f read-bytes buf)
(floating-point-bytes->real
buf
(if (= read-version 1)
(system-big-endian?)
#t)))
(get-number #f))))
(define/private (do-get-bytes)
(if (check-boundary)
#""
(if (read-version . < . 8)
(let* ([len (get-exact)]
[s (make-bytes len)])
(send f read-bytes s)
s)
(get-a-string #f #f))))
(def/public (get-bytes [maybe-box? [len #f]])
(let ([s (do-get-bytes)])
(when len
(set-box! len (max 1 (bytes-length s))))
(subbytes s 0 (max 0 (sub1 (bytes-length s))))))
(def/public (get-unterminated-bytes [maybe-box? [len #f]])
(let ([s (do-get-bytes)])
(when len
(set-box! len (bytes-length s)))
s))
(def/public (get-unterminated-bytes! [(make-box exact-nonnegative-integer?) len]
[(lambda (s) (and (bytes? s) (not (immutable? s)))) s])
(let ([s2 (do-get-bytes)])
(if ((bytes-length s2) . <= . (unbox len))
(begin
(bytes-copy! s 0 s2)
(set-box! len (bytes-length s2)))
(set! is-bad? #t))))
(def/public (get [(make-box real?) b])
(unless (check-boundary)
(if (exact-integer? (unbox b))
(set-box! b (get-exact))
(set-box! b (get-inexact)))))
(def/public (set-boundary [exact-nonnegative-integer? n])
(set! boundaries (cons (+ (tell) n) boundaries)))
(def/public (remove-boundary)
(set! boundaries (cdr boundaries)))
(define/private (check-boundary)
(if is-bad?
#t
(cond
[(and (pair? boundaries)
((tell) . > . (car boundaries)))
(set! is-bad? #t)
(error 'editor-stream-in%
"overread (caused by file corruption?; ~a vs ~a)" (tell) (car boundaries))]
[(send f bad?)
(set! is-bad? #t)
(error 'editor-stream-in% "stream error")]
[else #f])))
(def/public (skip [exact-nonnegative-integer? n])
(if (read-version . < . 8)
(send f skip n)
(jump-to (+ n items))))
(def/public (tell)
(if (read-version . < . 8)
(send f tell)
(let ([pos (send f tell)])
(hash-set! pos-map items pos)
items)))
(def/public (jump-to [exact-nonnegative-integer? pos])
(if (read-version . < . 8)
(send f seek pos)
(let ([p (hash-ref pos-map pos #f)])
(if (not p)
(begin
(let loop ()
(when (and (items . < . pos) (not is-bad?))
(skip-one #f)
(loop)))
(unless (= items pos)
(set! is-bad? #t)))
(begin
(send f seek p)
(set! items pos))))))
(def/public (ok?) (not is-bad?)))
(set-editor-stream-in%! editor-stream-in%)
;; ----------------------------------------
(defclass editor-stream-out% editor-stream%
(init-rest args)
(define f
(case-args
args
[([editor-stream-out-base% base]) base]
(init-name 'editor-stream-out%)))
(define is-bad? #f)
(define col 72)
(define items 0)
(define pos-map (make-hash))
(super-new)
(define/private (check-ok)
(unless is-bad?
(when (send f bad?)
(error 'editor-stream-out% "stream error"))))
(def/public (put-fixed [exact-integer? v])
(check-ok)
(let-values ([(new-col spc)
(if ((+ col 12) . > . 72)
(values 11 #"\n")
(values (+ col 12) #" "))])
(let ([s (number->string v)])
(send f
write-bytes
(bytes-append spc
(make-bytes (- 11 (string-length s)) (char->integer #\space))
(string->bytes/latin-1 s))))
(set! items (add1 items)))
this)
(define/public (put . args)
(case-args
args
[([exact-nonnegative-integer? n][bytes? s])
(do-put-bytes (subbytes s 0 n))]
[([bytes? s])
(do-put-bytes (bytes-append s #"\0"))]
[([exact-integer? n])
(do-put-number n)]
[([real? n])
(do-put-number (exact->inexact n))]
(method-name 'editor-stream-out% 'put)))
(def/public (put-unterminated [bytes? s])
(do-put-bytes s))
(define/private (do-put-bytes orig-s)
(define (single-string)
(if ((bytes-length orig-s) . < . 72)
(let ([s (open-output-bytes)])
(write orig-s s)
(let* ([v (get-output-bytes s)]
[len (bytes-length v)])
(if (len . >= . 72)
(multiple-strings)
(begin
(if ((+ col len 1) . > . 72)
(send f write-bytes #"\n")
(send f write-bytes #" "))
(send f write-bytes v)
(set! col 72))))) ;; forcing a newline after every string makes the file more readable
(multiple-strings)))
(define (multiple-strings)
(send f write-bytes #"\n(")
(let loop ([offset 0][remain (bytes-length orig-s)])
(unless (zero? remain)
(let lloop ([amt (min 50 remain)][retry? #t])
(let ([s (open-output-bytes)])
(write (subbytes orig-s offset (+ offset amt)) s)
(let* ([v (get-output-bytes s)]
[len (bytes-length v)])
(if (len . <= . 71)
(if (and (len . < . 71)
retry?
(amt . < . remain))
(lloop (add1 amt) #t)
(begin
(send f write-bytes #"\n ")
(send f write-bytes v)
(loop (+ offset amt) (- remain amt))))
(lloop (sub1 amt) #f)))))))
(send f write-bytes #"\n)")
(set! col 1))
(check-ok)
(do-put-number (bytes-length orig-s))
(single-string)
(set! items (add1 items))
this)
(define/private (do-put-number v)
(check-ok)
(let* ([s (string->bytes/latin-1 (format " ~a" v))]
[len (bytes-length s)])
(if ((+ col len) . > . 72)
(begin
(set! col (sub1 len))
(bytes-set! s 0 (char->integer #\newline)))
(set! col (+ col len)))
(send f write-bytes s)
(set! items (add1 items))
this))
(def/public (tell)
(let ([pos (send f tell)])
(hash-set! pos-map items (cons pos col))
items))
(def/public (jump-to [exact-nonnegative-integer? icount])
(unless is-bad?
(let ([p (hash-ref pos-map icount #f)])
(when p
(send f seek (car p))
(set! col (cdr p))
(set! items icount)))))
(def/public (ok?) (not is-bad?))
(def/public (pretty-finish)
(unless is-bad?
(when (positive? col)
(send f write-bytes #"\n")
(set! col 0))))
(def/public (pretty-start)
(define (show s)
(send f write-bytes (if (string? s) (string->bytes/latin-1 s) s)))
(when (positive? col)
(show #"\n"))
(show #"#|\n This file is in plt scheme editor format.\n")
(show (format " Open this file in dr-scheme version ~a or later to read it.\n" (version)))
(show #"\n")
(show #" Most likely, it was created by saving a program in DrScheme,\n")
(show #" and it probably contains a program with non-text elements\n")
(show #" (such as images or comment boxes).\n")
(show #"\n")
(show #" http://www.plt-scheme.org\n|#\n")
(set! col 0)))
(set-editor-stream-out%! editor-stream-out%)

1438
collects/mred/private/wxme/style.ss Normal file
View File

File diff suppressed because it is too large Load Diff

5482
collects/mred/private/wxme/text.ss Normal file
View File

File diff suppressed because it is too large Load Diff

307
collects/mred/private/wxme/undo.ss Normal file
View File

@ -0,0 +1,307 @@
#lang scheme/base
(require scheme/class
"private.ss"
"snip.ss"
"snip-flags.ss")
(provide proc-record%
unmodify-record%
insert-record%
insert-snip-record%
delete-record%
delete-snip-record%
style-change-record%
style-change-snip-record%
move-snip-record%
resize-snip-record%
composite-record%)
(define (disown snip)
(when (has-flag? (snip->flags snip) OWNED)
(send snip set-s-flags (remove-flag (snip->flags snip) OWNED))))
(define change-record%
(class object%
(super-new)
(define/public (cancel) (void))
(define/public (undo editor) #f)
(define/public (drop-set-unmodified) (void))
(define/public (is-composite?) #f)
(define/public (get-id) #f)
(define/public (get-parity) 0)
(define/public (inverse) #f)))
(define proc-record%
(class change-record%
(init-field proc)
(super-new)
(define/override (undo editor)
(proc))))
(define unmodify-record%
(class change-record%
(init-field cont?)
(define ok? #t)
(super-new)
(define/override (undo editor)
(when ok?
(send editor set-modified #f))
cont?)
(define/override (drop-set-unmodified)
(set! ok? #f))))
(define insert-record%
(class change-record%
(init-field start)
(init length)
(init-field cont?
startsel
endsel)
(define end (+ start length))
(super-new)
(define/override (undo editor)
(send editor delete start end)
(send editor set-position startsel endsel)
cont?)))
(define insert-snip-record%
(class change-record%
(init-field snip
cont?)
(super-new)
(define/override (undo editor)
(send editor delete snip)
(unless cont?
(send editor set-selected snip))
cont?)))
(define-struct delete-snip-item (snip before x y))
(define delete-snip-record%
(class change-record%
(init-field cont?)
(define deletions null)
(define undid? #f)
(super-new)
(define/public (insert-snip snip before x y)
(set! deletions (cons (make-delete-snip-item snip before x y)
deletions)))
(define/override (cancel)
(unless undid?
(for-each (lambda (i)
(let ([snip (delete-snip-item-snip i)])
(disown snip)
(send snip set-admin #f)))
deletions)))
(define/override (undo editor)
(unless cont?
(send editor no-selected))
(for-each
(lambda (del)
(let ([snip (delete-snip-item-snip del)])
;; have to turn off the owned flag; we know that it's really ours
(disown snip)
(send editor insert snip
(delete-snip-item-before del)
(delete-snip-item-x del)
(delete-snip-item-y del))
(unless cont?
(send editor add-selected snip))))
deletions)
(set! undid? #t)
cont?)))
(define delete-record%
(class change-record%
(init-field start
end
cont?
startsel
endsel)
(define deletions null)
(define clickbacks null)
(define undid? #f)
(super-new)
(define/public (insert-snip snip)
(set! deletions (cons snip deletions)))
(define/public (add-clickback click)
(set! clickbacks (cons click clickbacks)))
(define/override (cancel)
(unless undid?
(for-each (lambda (snip)
(disown snip)
(send snip set-admin #f))
deletions)))
(define/override (undo editor)
;; have to turn off the owned flag; we know that it's really ours
(for-each disown deletions)
(send editor do-insert-snips deletions start)
(for-each (lambda (cb)
(send editor set-clickback cb))
clickbacks)
(send editor set-position startsel endsel)
(set! undid? #t)
cont?)))
(define style-change-record%
(class change-record%
(init-field start
end
cont?
startsel
endsel
restore-selection?)
(define changes null)
(super-new)
(define/public (add-style-change start end style)
(set! changes (cons (vector start end style)
changes)))
(define/override (undo editor)
(for-each (lambda (c)
(send editor change-style
(vector-ref c 2)
(vector-ref c 0)
(vector-ref c 1)))
(reverse changes))
(when restore-selection?
(send editor set-position startsel endsel))
cont?)))
(define style-change-snip-record%
(class change-record%
(init-field cont?)
(define changes null)
(super-new)
(define/public (add-style-change snip style)
(set! changes (cons (cons snip style) changes)))
(define/override (undo editor)
(unless cont?
(send editor no-selected))
(for-each (lambda (s)
(send editor change-style (cdr s) (cdr s))
(unless cont?
(send editor add-selected (car s))))
(reverse changes))
cont?)))
(define move-snip-record%
(class change-record%
(init-field snip
x
y
delta?
cont?)
(super-new)
(define/override (undo editor)
(if delta?
(send editor move snip x y)
(send editor move-to snip x y))
cont?)))
(define resize-snip-record%
(class change-record%
(init-field snip
x
y
cont?)
(super-new)
(define/override (undo editor)
(send editor resize snip x y)
cont?)))
(define composite-record%
(class change-record%
(init count)
(init-field id
parity?)
(unless id
(set! id (if parity?
(cons this #f)
(cons #f this))))
(define seq (make-vector count))
(super-new)
(define/override (cancel)
(for ([c (in-vector seq)])
(send c cancel)))
(define/override (undo editor)
(for ([c (in-vector seq)])
(send c undo))
#f)
(define/override (drop-set-unmodified)
(for ([c (in-vector seq)])
(send c drop-set-unmodified)))
(define/public (add-undo pos c)
(vector-set! seq (- (vector-length seq) pos 1) c))
(define/override (is-composite?) #t)
(define/override (get-id) id)
(define/override (get-parity) parity?)
(define/override (inverse)
(make-object inverse-record% id (not parity?)))))
(define inverse-record%
(class change-record%
(init-field id
parity?)
(define/private (get)
(if parity?
(car id)
(cdr id)))
(define/override (cancel)
;; Avoid double-frees by not doing anything
(void))
(define/override (undo editor)
(send (get) undo editor))
(define/override (drop-set-unmodified)
(let ([c (get)])
(when c
(send c drop-set-unmodified))))
(define/override (get-id) id)
(define/override (get-parity) parity?)
(define/override (inverse)
(send (get) inverse))))

151
collects/mred/private/wxme/wordbreak.ss Normal file
View File

@ -0,0 +1,151 @@
#lang scheme/base
(require scheme/class
"../syntax.ss"
"cycle.ss")
(provide editor-wordbreak-map%
the-editor-wordbreak-map
standard-wordbreak)
(defclass editor-wordbreak-map% object%
(define char-map (make-hash))
(super-new)
(hash-set! char-map #\- '(line))
(def/public (set-map [char? ch] [(make-list (symbol-in caret line selection user1 user2)) mask])
(hash-set! char-map ch mask))
(def/public (get-map [char? ch])
(or (hash-ref char-map ch #f)
(cond
[(or (char-alphabetic? ch)
(char-numeric? ch))
'(caret line selection)]
[(not (char-whitespace? ch))
'(line)]
[else null]))))
(define the-editor-wordbreak-map (new editor-wordbreak-map%))
(define MAX-DIST-TRY 30)
(define wb-get-map (generic editor-wordbreak-map% get-map))
(define (string-ref* str n)
(if (n . >= . (string-length str))
#\nul
(string-ref str n)))
(define/top (standard-wordbreak [text% win]
[(make-or-false (make-box exact-nonnegative-integer?)) startp]
[(make-or-false (make-box exact-nonnegative-integer?)) endp]
[(symbol-in caret line selection user1 user2)reason])
(with-method ([get-map ((send win get-wordbreak-map) get-map)])
(define (nonbreak? ch) (memq reason (get-map ch)))
(when startp
(let* ([start (unbox startp)]
[pstart start]
[lstart (send win find-newline 'backward start 0)]
[lstart (if lstart
(if (eq? 'caret reason)
(or (and (positive? lstart)
(send win find-newline 'backward (sub1 lstart) 0))
0)
lstart)
0)]
[lend (min (+ start 1) (send win last-position))]
[tstart (if ((- start lstart) . > . MAX-DIST-TRY)
(- start MAX-DIST-TRY)
lstart)]
[text (send win get-text tstart lend)]
[start (- start tstart)]
[pstart (- pstart tstart)])
(let ploop ([phase1-complete? #f]
[phase2-complete? #f]
[start start]
[pstart pstart]
[text text]
[tstart tstart])
(let*-values ([(start phase1-complete?)
(if phase1-complete?
(values start #t)
(let ([start (if (and (positive? start)
(nonbreak? (string-ref* text start)))
(sub1 start)
start)])
(values start
(not (nonbreak? (string-ref* text start))))))]
[(start phase2-complete?)
(if (not (eq? 'selection reason))
(if (not phase2-complete?)
(let loop ([start start])
(if (and (positive? start)
(not (nonbreak? (string-ref* text start))))
(loop (sub1 start))
(if (nonbreak? (string-ref* text start))
(values start #t)
(values start #f))))
(values start #t))
(values start phase2-complete?))])
(let loop ([start start])
(if (and (positive? start)
(nonbreak? (string-ref* text start)))
(loop (sub1 start))
(let ([start (if (and (start . < . pstart)
(not (nonbreak? (string-ref* text start))))
(add1 start)
start)])
(if (and (zero? start)
(not (= lstart tstart)))
(ploop phase1-complete?
phase2-complete?
(+ start (- tstart lstart))
(+ pstart (- tstart lstart))
(send win get-text lstart lend)
lstart)
(set-box! startp (+ start tstart))))))))))
(when endp
(let* ([end (unbox endp)]
[lstart end]
[lend (send win find-newline 'forward end)]
[lend (if lend
(if (eq? 'caret reason)
(or (send win find-newline 'forward (+ lend 1))
(send win last-position))
lend)
(send win last-position))]
[tend (if ((- lend end) . > . MAX-DIST-TRY)
(+ end MAX-DIST-TRY)
lend)]
[text (send win get-text lstart tend)]
[end (- end lstart)]
[lend (- lend lstart)]
[tend (- tend lstart)])
(let ploop ([phase1-complete? #f]
[text text]
[tend tend])
(let-values ([(end phase1-complete?)
(if phase1-complete?
(values end #t)
(let loop ([end end])
(if (and (end . < . tend)
(not (nonbreak? (string-ref* text end))))
(loop (add1 end))
(if (end . < . tend)
(values end #t)
(values end #f)))))])
(let loop ([end end])
(if (and (end . < . tend)
(nonbreak? (string-ref* text end)))
(loop (add1 end))
(if (and (= tend end) (not (= lend tend)))
(ploop phase1-complete?
(send win get-text lstart (+ lstart lend))
lend)
(set-box! endp (+ end lstart)))))))))))

63
collects/mred/private/wxme/wx.ss Normal file
View File

@ -0,0 +1,63 @@
#lang scheme/base
(require "../kernel.ss")
(define the-clipboard (get-the-clipboard))
(define the-x-selection-clipboard (get-the-x-selection))
(define the-brush-list (get-the-brush-list))
(define the-pen-list (get-the-pen-list))
(define the-font-list (get-the-font-list))
(define the-color-database (get-the-color-database))
(define the-font-name-directory (get-the-font-name-directory))
(define (family-symbol? s)
(memq s '(default decorative roman script
swiss modern symbol system)))
(define (style-symbol? s)
(memq s '(normal italic slant)))
(define (weight-symbol? s)
(memq s '(normal bold light)))
(define (smoothing-symbol? s)
(memq s '(default smoothed unsmoothed partly-smoothed)))
(define (size? v) (and (exact-positive-integer? v)
(byte? v)))
(provide event%
mouse-event%
key-event%
timer%
canvas%
bitmap-dc%
color%
the-color-database
pen%
the-pen-list
brush%
the-brush-list
font%
the-font-list
the-font-name-directory
cursor%
bitmap%
dc<%>
post-script-dc%
printer-dc%
current-eventspace
clipboard-client%
clipboard<%>
the-clipboard
the-x-selection-clipboard
get-double-click-threshold
begin-refresh-sequence
end-refresh-sequence
begin-busy-cursor
end-busy-cursor
hide-cursor
run-printout
current-ps-setup
family-symbol?
style-symbol?
weight-symbol?
smoothing-symbol?)
(define (get-double-click-threshold)
(get-double-click-time))

1
collects/mred/private/wxmenu.ss
View File

@ -3,6 +3,7 @@
mzlib/class100
mzlib/list
(prefix wx: "kernel.ss")
(prefix wx: "wxme/keymap.ss")
"lock.ss"
"const.ss"
"helper.ss"

2
collects/mred/private/wxtextfield.ss
View File

@ -2,6 +2,8 @@
(require mzlib/class
mzlib/class100
(prefix wx: "kernel.ss")
(prefix wx: "wxme/text.ss")
(prefix wx: "wxme/editor-canvas.ss")
"lock.ss"
"const.ss"
"check.ss"

2
collects/mred/private/wxtop.ss
View File

@ -4,6 +4,8 @@
mzlib/etc
mzlib/list
(prefix wx: "kernel.ss")
(prefix wx: "wxme/editor-canvas.ss")
(prefix wx: "wxme/editor-snip.ss")
"lock.ss"
"helper.ss"
"const.ss"

2
collects/scheme/private/for.ss
View File

@ -637,7 +637,7 @@
(if (null? sequences) sequence (append-sequences all #f))))
(define (in-cycle sequence . sequences)
(let ([all (cons sequence sequences)])
(check-sequences 'in-cycle sequences)
(check-sequences 'in-cycle all)
(append-sequences all #t)))
(define (in-parallel . sequences)

5
collects/scheme/private/kw.ss
View File

@ -386,7 +386,8 @@
#`[core
#,(annotate-method
(syntax-property
#`(lambda #,(syntax-property
(quasisyntax/loc stx
(lambda #,(syntax-property
#`(given-kws given-args
new-plain-id ...
opt-arg ...
@ -402,7 +403,7 @@
(opt-arg ...) (opt-arg? ...)
(new-plain-id ... . new-rest)
;; the original body, finally:
body1 body ...)))
body1 body ...))))
'certify-mode
'transparent))]
'certify-mode

8
collects/scribblings/gui/clipboard-intf.scrbl
View File

@ -80,6 +80,14 @@ See @|timediscuss| for a discussion of the @scheme[time] argument. If
}
@defmethod[(same-clipboard-client? [owner (is-a?/c clipboard-client%)])
boolean?]{
Returns @scheme[#t] if @scheme[owner] currently owns the clipboard,
@scheme[#f] otherwise.}
@defmethod[(set-clipboard-bitmap [new-bitmap (is-a?/c bitmap%)]
[time (and/c exact? integer?)])
void?]{

15
collects/scribblings/gui/dc-intf.scrbl
View File

@ -13,6 +13,21 @@ when the drawing coordinates are in the range @scheme[-16383] to
@scheme[16383]. This restriction applies to the coordinates both
before and after offsets and scaling factors are applied.
@defmethod[(cache-font-metrics-key)
exact-integer?]{
Returns an integer that, if not @scheme[0], corresponds to a
particular kind of device and scaling factor, such that text-extent
information (from @method[dc<%> get-text-extent], @method[dc<%>
get-char-height], etc.) is the same. The key is valid across all
@scheme[dc<%>] instances, even among different classes.
A @scheme[0] result indicates that the current configuration of
@this-obj[] does not fit into a common category, and so no key is
available for caching text-extent information.}
@defmethod[(clear)
void?]{

124
collects/scribblings/gui/editor-intf.scrbl
View File

@ -59,7 +59,7 @@ The system adds undoers to an editor (in response to other method
}
@defmethod[(adjust-cursor [event (is-a?/c mouse-event%)])
(or/c (is-a?/c cursor%) false/c)]{
(or/c (is-a?/c cursor%) #f)]{
@methspec{
@ -332,9 +332,9 @@ Returns @scheme[#t].
}}
@defmethod*[([(change-style [delta (or/c (is-a?/c style-delta%) false/c)])
@defmethod*[([(change-style [delta (or/c (is-a?/c style-delta%) #f)])
void?]
[(change-style [style (or/c (is-a?/c style<%>) false/c)])
[(change-style [style (or/c (is-a?/c style<%>) #f)])
void?])]{
Changes the style for @techlink{items} in the editor, either by
@ -456,6 +456,12 @@ Returns the name of a style to be used for newly inserted text,
}
@defmethod[(do-copy) void?]{
See @xmethod[text% do-copy] or @xmethod[pasteboard% do-copy].}
@defmethod[(do-edit-operation [op (one-of/c 'undo 'redo 'clear 'cut 'copy 'paste
'kill 'select-all 'insert-text-box
'insert-pasteboard-box 'insert-image)]
@ -492,6 +498,17 @@ See @|timediscuss| for a discussion of the @scheme[time] argument. If
}
@defmethod[(do-paste) void?]{
See @xmethod[text% do-paste] or @xmethod[pasteboard% do-paste].}
@defmethod[(do-paste-x-selection) void?]{
See @xmethod[text% do-paste-x-selection] or @xmethod[pasteboard% do-paste-x-selection].}
@defmethod[(editor-location-to-dc-location [x real?]
[y real?])
(values real? real?)]{
@ -530,7 +547,7 @@ more information.
@defmethod[(find-first-snip)
(or/c (is-a?/c snip%) false/c)]{
(or/c (is-a?/c snip%) #f)]{
Returns the first snip in the editor, or @scheme[#f] if the editor is
empty. To get all of the snips in the editor, use the @xmethod[snip%
@ -553,7 +570,7 @@ For @scheme[text%] objects: @|FCA| @|OVD|
}
@defmethod[(get-active-canvas)
(or/c (is-a?/c editor-canvas%) false/c)]{
(or/c (is-a?/c editor-canvas%) #f)]{
If the editor is displayed in a canvas, this method returns the canvas
that most recently had the keyboard focus (while the editor was
@ -562,7 +579,7 @@ If the editor is displayed in a canvas, this method returns the canvas
}
@defmethod[(get-admin)
(or/c (is-a?/c editor-admin%) false/c)]{
(or/c (is-a?/c editor-admin%) #f)]{
Returns the @scheme[editor-admin%] object currently managing this
editor or @scheme[#f] if the editor is not displayed.
@ -570,7 +587,7 @@ Returns the @scheme[editor-admin%] object currently managing this
}
@defmethod[(get-canvas)
(or/c (is-a?/c editor-canvas%) false/c)]{
(or/c (is-a?/c editor-canvas%) #f)]{
If @method[editor<%> get-active-canvas] returns a canvas, that canvas
is also returned by this method. Otherwise, if @method[editor<%>
@ -591,7 +608,7 @@ Returns a list of canvases displaying the editor. An editor may be
}
@defmethod[(get-dc)
(or/c (is-a?/c dc<%>) false/c)]{
(or/c (is-a?/c dc<%>) #f)]{
Typically used (indirectly) by snip objects belonging to the
editor. Returns a destination drawing context which is suitable for
@ -610,8 +627,8 @@ Returns the font descent for the editor. This method is primarily used
}
@defmethod[(get-extent [w (or/c (box/c (and/c real? (not/c negative?))) false/c)]
[h (or/c (box/c (and/c real? (not/c negative?))) false/c)])
@defmethod[(get-extent [w (or/c (box/c (and/c real? (not/c negative?))) #f)]
[h (or/c (box/c (and/c real? (not/c negative?))) #f)])
void?]{
Gets the current extent of the editor's graphical representation.
@ -622,8 +639,8 @@ Gets the current extent of the editor's graphical representation.
}
@defmethod[(get-file [directory (or/c path? false/c)])
(or/c path-string? false/c)]{
@defmethod[(get-file [directory (or/c path? #f)])
(or/c path-string? #f)]{
@methspec{
Called when the user must be queried for a filename to load an
@ -644,8 +661,8 @@ If the editor is displayed in a single canvas, then the canvas's
}}
@defmethod[(get-filename [temp (box/c (or/c any/c false/c)) #f])
(or/c path-string? false/c)]{
@defmethod[(get-filename [temp (box/c (or/c any/c #f)) #f])
(or/c path-string? #f)]{
Returns the path name of the last file saved from or loaded into this
editor, @scheme[#f] if the editor has no filename.
@ -665,7 +682,7 @@ a discussion of flattened vs. non-flattened text.
@defmethod[(get-focus-snip)
(or/c (is-a?/c snip%) false/c)]{
(or/c (is-a?/c snip%) #f)]{
@index['("keyboard focus" "snips")]{Returns} the snip within the
editor that gets the keyboard focus when the editor has the focus, or
@ -698,7 +715,7 @@ See also @method[editor<%> set-inactive-caret-threshold] and
@defmethod[(get-keymap)
(or/c (is-a?/c keymap%) false/c)]{
(or/c (is-a?/c keymap%) #f)]{
Returns the main keymap currently used by the editor.
@ -788,7 +805,7 @@ If the result is @scheme[#t], then the editor accepts only plain-text
}
@defmethod[(get-snip-data [thesnip (is-a?/c snip%)])
(or/c (is-a?/c editor-data%) false/c)]{
(or/c (is-a?/c editor-data%) #f)]{
@methspec{
@ -805,8 +822,8 @@ Returns @scheme[#f].
@defmethod[(get-snip-location [thesnip (is-a?/c snip%)]
[x (or/c (box/c real?) false/c) #f]
[y (or/c (box/c real?) false/c) #f]
[x (or/c (box/c real?) #f) #f]
[y (or/c (box/c real?) #f) #f]
[bottom-right? any/c #f])
boolean?]{
@ -850,8 +867,8 @@ Returns the style list currently in use by the editor.
}
@defmethod[(get-view-size [w (or/c (box/c (and/c real? (not/c negative?))) false/c)]
[h (or/c (box/c (and/c real? (not/c negative?))) false/c)])
@defmethod[(get-view-size [w (or/c (box/c (and/c real? (not/c negative?))) #f)]
[h (or/c (box/c (and/c real? (not/c negative?))) #f)])
void?]{
Returns the visible area into which the editor is currently being
@ -868,8 +885,8 @@ If the @techlink{display} is an editor canvas, see also
}
@defmethod[(global-to-local [x (or/c (box/c real?) false/c)]
[y (or/c (box/c real?) false/c)])
@defmethod[(global-to-local [x (or/c (box/c real?) #f)]
[y (or/c (box/c real?) #f)])
void?]{
Converts the given coordinates from top-level @techlink{display} coordinates
@ -949,7 +966,7 @@ The @scheme[show-errors?] argument is no longer used.
}
@defmethod[(insert-image [filename (or/c path-string? false/c) #f]
@defmethod[(insert-image [filename (or/c path-string? #f) #f]
[type (one-of/c 'unknown 'gif 'jpeg 'xbm 'xpm 'bmp 'pict) 'unknown]
[relative-path? any/c #f]
[inline? any/c #t])
@ -974,7 +991,7 @@ calling
@defmethod[(insert-port [port input-port]
[format (one-of/c 'guess 'same 'copy 'standard
'text 'text-force-cr) 'guess]
[show-errors? any/c #t])
[replace-styles? any/c #t])
(one-of/c 'standard 'text 'text-force-cr)]{
Use @method[editor<%> insert-file], instead.
@ -991,8 +1008,8 @@ The @scheme[port] must support position setting with @scheme[file-position].
For information on @scheme[format], see
@method[editor<%> load-file].
The @scheme[show-errors?] argument is no longer used.
if @scheme[replace-styles?] is true, then styles in the current style
list are replaced by style specifications in @scheme[port]'s stream.
}
@defmethod[(invalidate-bitmap-cache [x real? 0.0]
@ -1030,13 +1047,20 @@ Returns @scheme[#t] if the editor is currently locked, @scheme[#f]
@defmethod[(is-modified?)
boolean?]{
Returns @scheme[#t] is the editor has been modified since the last
Returns @scheme[#t] if the editor has been modified since the last
save or load (or the last call to @method[editor<%> set-modified]
with @scheme[#f]), @scheme[#f] otherwise.
}
@defmethod[(is-printing?)
boolean?]{
Returns @scheme[#t] if the editor is currently being printed through
the @method[editor<%> print] method, @scheme[#f] otherwise.}
@defmethod[(kill [time (and/c exact? integer?) 0])
void?]{
@ -1056,7 +1080,7 @@ See also @method[editor<%> cut].
}
@defmethod[(load-file [filename (or/c path-string? false/c) #f]
@defmethod[(load-file [filename (or/c path-string? #f) #f]
[format (one-of/c 'guess 'same 'copy 'standard
'text 'text-force-cr) 'guess]
[show-errors? any/c #t])
@ -1117,8 +1141,8 @@ See also @method[editor<%> on-load-file], @method[editor<%>
}
@defmethod[(local-to-global [x (box/c real?)]
[y (box/c real?)])
@defmethod[(local-to-global [x (or/c (box/c real?) #f)]
[y (or/c (box/c real?) #f)])
void?]{
Converts the given coordinates from editor @techlink{location}
@ -1499,7 +1523,7 @@ Creates a @scheme[editor-snip%] with either a sub-editor from
}}
@defmethod[(on-new-image-snip [filename (or/c path? false/c)]
@defmethod[(on-new-image-snip [filename (or/c path? #f)]
[kind (one-of/c 'unknown 'gif 'jpeg 'xbm 'xpm 'bmp 'pict)]
[relative-path? any/c]
[inline? any/c])
@ -1689,7 +1713,7 @@ To extend or re-implement copying, override the @xmethod[text%
@defmethod[(print [interactive? any/c #t]
[fit-on-page? any/c #t]
[output-mode (one-of/c 'standard 'postscript) 'standard]
[parent (or/c (or/c @scheme[frame%] (is-a?/c dialog%)) false/c) #f]
[parent (or/c (or/c @scheme[frame%] (is-a?/c dialog%)) #f) #f]
[force-ps-page-bbox? any/c #t]
[as-eps? any/c #f])
void?]{
@ -1750,18 +1774,26 @@ The printing margins are determined by @method[ps-setup%
}
@defmethod[(print-to-dc [dc (is-a?/c dc<%>)])
@defmethod[(print-to-dc [dc (is-a?/c dc<%>)]
[page-number exact-integer? -1])
void?]{
Prints the editor into the given drawing context. See also
@method[editor<%> print].
If @scheme[page-number] is a non-negative integer, then just the
indicated page is printed, where pages are numbered from
@scheme[1]. (So, supplying @scheme[0] as @scheme[page-number] produces
no output.) When @scheme[page-number] is negative, the
@method[dc<%> start-page] and @scheme[dc<%> end-page] methods of @scheme[dc] are
called for each page.
}
@defmethod[(put-file [directory (or/c path? false/c)]
[default-name (or/c path? false/c)])
(or/c path-string? false/c)]{
@defmethod[(put-file [directory (or/c path? #f)]
[default-name (or/c path? #f)])
(or/c path-string? #f)]{
@methspec{
Called when the user must be queried for a filename to save an
@ -1860,7 +1892,7 @@ See also @method[editor<%> add-undo].
[width (and/c real? (not/c negative?))]
[height (and/c real? (not/c negative?))]
[draw-caret (one-of/c 'no-caret 'show-inactive-caret 'show-caret)]
[background (or/c (is-a?/c color%) false/c)])
[background (or/c (is-a?/c color%) #f)])
void?]{
Repaints a region of the editor, generally called by an editor
@ -1940,7 +1972,7 @@ If @scheme[redraw-now?] is @scheme[#f], the editor will require
}
@defmethod[(save-file [filename (or/c path-string? false/c) #f]
@defmethod[(save-file [filename (or/c path-string? #f) #f]
[format (one-of/c 'guess 'same 'copy 'standard
'text 'text-force-cr) 'same]
[show-errors? any/c #t])
@ -2074,7 +2106,7 @@ Normally, this method is called only by @xmethod[editor-canvas%
}
@defmethod[(set-admin [admin (or/c (is-a?/c editor-admin%) false/c)])
@defmethod[(set-admin [admin (or/c (is-a?/c editor-admin%) #f)])
void?]{
Sets the editor's administrator. This method is only called by an
@ -2087,7 +2119,7 @@ get-admin]}]
}
@defmethod[(set-caret-owner [snip (or/c (is-a?/c snip%) false/c)]
@defmethod[(set-caret-owner [snip (or/c (is-a?/c snip%) #f)]
[domain (one-of/c 'immediate 'display 'global) 'immediate])
void?]{
@ -2127,8 +2159,8 @@ See also @method[editor<%> get-focus-snip].
}
@defmethod[(set-cursor [cursor (or/c (is-a?/c cursor%) false/c)]
[override? any/c @scheme[#t]])
@defmethod[(set-cursor [cursor (or/c (is-a?/c cursor%) #f)]
[override? any/c #t])
void?]{
Sets the custom cursor for the editor to @scheme[cursor]. If
@ -2148,7 +2180,7 @@ An embedding editor's custom cursor can override the cursor of an
}
@defmethod[(set-filename [filename (or/c path-string? false/c)]
@defmethod[(set-filename [filename (or/c path-string? #f)]
[temporary? any/c #f])
void?]{
@ -2172,7 +2204,7 @@ Sets the threshold for painting an inactive selection. See
}
@defmethod[(set-keymap [keymap (or/c (is-a?/c keymap%) false/c) #f])
@defmethod[(set-keymap [keymap (or/c (is-a?/c keymap%) #f) #f])
void?]{
Sets the current keymap for the editor. A @scheme[#f] argument removes
@ -2336,7 +2368,7 @@ recalculated on demand.
See also @method[editor<%> invalidate-bitmap-cache].}
@defmethod[(style-has-changed [style (or/c (is-a?/c style<%>) false/c)])
@defmethod[(style-has-changed [style (or/c (is-a?/c style<%>) #f)])
void?]{
Notifies the editor that a style in its style list has changed. This

16
collects/scribblings/gui/editor-stream-in-base-class.scrbl
View File

@ -24,14 +24,18 @@ Returns @scheme[#t] if there has been an error reading from the
@defmethod[(read [data (and/c vector? (not immutable?))])
exact-nonnegative-integer?]{
Reads Latin-1 characters to fill the supplied vector. The return value is the
number of characters read, which may be less than the number
Like @method[editor-stream-in-base% read-bytes], but fills a supplied
vector with Latin-1 characters instead of filling a byte string. This method
is implemented by default via @method[editor-stream-in-base% read-bytes].}
@defmethod[(read-bytes [bstr (and/c bytes? (not immutable?))])
exact-nonnegative-integer?]{
Reads bytes to fill the supplied byte string. The return value is the
number of bytes read, which may be less than the number
requested if the stream is emptied. If the stream is emptied, the
next call to @method[editor-stream-in-base% bad?] must return
@scheme[#t].
}
@scheme[#t].}
@defmethod[(seek [pos exact-nonnegative-integer?])
void?]{

10
collects/scribblings/gui/editor-stream-out-base-class.scrbl
View File

@ -39,6 +39,12 @@ Returns the current stream position.
@defmethod[(write [data (listof char?)])
void?]{
Writes data (encoded as Latin-1 characters) to the stream.
Writes data (encoded as Latin-1 characters) to the stream. This method
is implemented by default via @method[editor-stream-out-base%
write-bytes].}
@defmethod[(write-bytes [bstr bytes?]) void?]{
Writes data to the stream.}}
}}

14
collects/scribblings/gui/editor-stream-out-class.scrbl
View File

@ -62,8 +62,9 @@ This method is called by @scheme[write-editor-global-header].
Writes @scheme[v], or @scheme[n] bytes of @scheme[v].
When @scheme[n] is supplied, use @method[editor-stream-in%
get-unterminated-bytes] to read the bytes later.
When @scheme[n] is supplied with a byte-string @scheme[v], use
@method[editor-stream-in% get-unterminated-bytes] to read the bytes
later.
If @scheme[n] is not supplied and @scheme[v] is a byte string, then
for historical reasons, the actual number of bytes written includes a
@ -85,9 +86,14 @@ Puts a fixed-sized integer into the stream. This method is needed
fixed-size number.
Numbers written to a stream with @method[editor-stream-out% put-fixed]
must be read with @method[editor-stream-in% get-fixed].
must be read with @method[editor-stream-in% get-fixed].}
@defmethod[(put-unterminated [v bytes?]) (is-a?/c editor-stream-out%)]{
The same as calling @method[editor-stream-out% put] with
@scheme[(bytes-length v)] and @scheme[v].}
}
@defmethod[(tell)
exact-nonnegative-integer?]{

9
collects/scribblings/gui/pasteboard-class.scrbl
View File

@ -499,7 +499,8 @@ Deletes @scheme[snip] when provided, or deletes the currently selected
}
@defmethod[(do-copy [time (and/c exact? integer?)]
@defmethod[#:mode override
(do-copy [time (and/c exact? integer?)]
[extend? any/c])
void?]{
@ -523,7 +524,8 @@ Copies the current selection, extending the current clipboard contexts
}}
@defmethod[(do-paste [time (and/c exact? integer?)])
@defmethod[#:mode override
(do-paste [time (and/c exact? integer?)])
void?]{
@methspec{
@ -544,7 +546,8 @@ Pastes.
}}
@defmethod[(do-paste-x-selection [time (and/c exact? integer?)])
@defmethod[#:mode override
(do-paste-x-selection [time (and/c exact? integer?)])
void?]{
@methspec{

130
collects/scribblings/gui/text-class.scrbl
View File

@ -324,12 +324,12 @@ See also @method[text% hide-caret].
@defmethod*[#:mode extend
([(change-style [delta (or/c (is-a?/c style-delta%) false/c)]
([(change-style [delta (or/c (is-a?/c style-delta%) #f)]
[start (or/c exact-nonnegative-integer? (one/of 'start)) 'start]
[end (or/c exact-nonnegative-integer? (one/of 'end)) 'end]
[counts-as-mod? any/c #t])
void?]
[(change-style [style (or/c (is-a?/c style<%>) false/c)]
[(change-style [style (or/c (is-a?/c style<%>) #f)]
[start (or/c exact-nonnegative-integer? (one/of 'start)) 'start]
[end (or/c exact-nonnegative-integer? (one/of 'end)) 'end]
[counts-as-mod? any/c #t])
@ -422,7 +422,8 @@ Deletes the specified range or the currently selected text (when no
}
@defmethod[(do-copy [start exact-nonnegative-integer?]
@defmethod[#:mode override
(do-copy [start exact-nonnegative-integer?]
[end exact-nonnegative-integer?]
[time (and/c exact? integer?)]
[extend? any/c])
@ -446,7 +447,8 @@ Copy the data from @scheme[start] to @scheme[end], extending the current
}}
@defmethod[(do-paste [start exact-nonnegative-integer?]
@defmethod[#:mode override
(do-paste [start exact-nonnegative-integer?]
[time (and/c exact? integer?)])
void?]{
@methspec{
@ -467,7 +469,8 @@ Pastes into the @techlink{position} @scheme[start].
}}
@defmethod[(do-paste-x-selection [start exact-nonnegative-integer?]
@defmethod[#:mode override
(do-paste-x-selection [start exact-nonnegative-integer?]
[time (and/c exact? integer?)])
void?]{
@methspec{
@ -500,7 +503,7 @@ See also @method[text% delete].
@defmethod[(find-line [y real?]
[on-it? (or/c (box/c any/c) false/c) #f])
[on-it? (or/c (box/c any/c) #f) #f])
exact-nonnegative-integer?]{
Given a @techlink{location} in the editor, returns the line at the
@ -516,8 +519,17 @@ Given a @techlink{location} in the editor, returns the line at the
}
@defmethod[(find-next-non-string-snip [after (or/c (is-a?/c snip%) false/c)])
(or/c (is-a?/c snip%) false/c)]{
@defmethod[(find-newline [direction (one-of/c 'forward 'backward) 'forward]
[start (or/c exact-nonnegative-integer? (one/of 'start)) 'start]
[end (or/c exact-nonnegative-integer? (one/of 'eof)) 'eof])
(or/c exact-nonnegative-integer? #f)]{
Like @method[text% find-string], but specifically finds a paragraph
break (possibly more efficiently than searching text).}
@defmethod[(find-next-non-string-snip [after (or/c (is-a?/c snip%) #f)])
(or/c (is-a?/c snip%) #f)]{
Given a snip, returns the next snip in the editor (after the given
one) that is not an instance of @scheme[string-snip%]. If
@ -530,9 +542,9 @@ Given a snip, returns the next snip in the editor (after the given
@defmethod[(find-position [x real?]
[y real?]
[at-eol? (or/c (box/c any/c) false/c) #f]
[on-it? (or/c (box/c any/c) false/c) #f]
[edge-close? (or/c (box/c real?) false/c) #f])
[at-eol? (or/c (box/c any/c) #f) #f]
[on-it? (or/c (box/c any/c) #f) #f]
[edge-close? (or/c (box/c real?) #f) #f])
exact-nonnegative-integer?]{
Given a @techlink{location} in the editor, returns the @techlink{position} at the
@ -557,9 +569,9 @@ See @|ateoldiscuss| for a discussion of the @scheme[at-eol?] argument.
@defmethod[(find-position-in-line [line exact-nonnegative-integer?]
[x real?]
[at-eol? (or/c (box/c any/c) false/c) #f]
[on-it? (or/c (box/c any/c) false/c) #f]
[edge-close? (or/c (box/c real?) false/c) #f])
[at-eol? (or/c (box/c any/c) #f) #f]
[on-it? (or/c (box/c any/c) #f) #f]
[edge-close? (or/c (box/c real?) #f) #f])
exact-nonnegative-integer?]{
Given a @techlink{location} within a line of the editor, returns the
@ -579,8 +591,8 @@ See @method[text% find-position] for a discussion of
@defmethod[(find-snip [pos exact-nonnegative-integer?]
[direction (one-of/c 'before-or-none 'before 'after 'after-or-none)]
[s-pos (or/c (box/c exact-nonnegative-integer?) false/c) #f])
(or/c (is-a?/c snip%) false/c)]{
[s-pos (or/c (box/c exact-nonnegative-integer?) #f) #f])
(or/c (is-a?/c snip%) #f)]{
Returns the snip at a given @techlink{position}, or @scheme[#f] if an appropriate
snip cannot be found.
@ -615,7 +627,7 @@ can be any of the following:
[end (or/c exact-nonnegative-integer? (one/of 'eof)) 'eof]
[get-start? any/c #t]
[case-sensitive? any/c #t])
(or/c exact-nonnegative-integer? false/c)]{
(or/c exact-nonnegative-integer? #f)]{
Finds an exact-match string in the editor and returns its @techlink{position}.
If the string is not found, @scheme[#f] is returned.
@ -656,8 +668,8 @@ Finds all occurrences of a string using @method[text% find-string]. If
}
@defmethod[(find-wordbreak [start (or/c (box/c exact-nonnegative-integer?) false/c)]
[end (or/c (box/c exact-nonnegative-integer?) false/c)]
@defmethod[(find-wordbreak [start (or/c (box/c exact-nonnegative-integer?) #f)]
[end (or/c (box/c exact-nonnegative-integer?) #f)]
[reason (one-of/c 'caret 'line 'selection 'user1 'user2)])
void?]{
@ -804,8 +816,8 @@ Returns @scheme[#t] if the editor is in overwrite mode, @scheme[#f]
}
@defmethod[(get-position [start (or/c (box/c exact-nonnegative-integer?) false/c)]
[end (or/c (box/c exact-nonnegative-integer?) false/c) #f])
@defmethod[(get-position [start (or/c (box/c exact-nonnegative-integer?) #f)]
[end (or/c (box/c exact-nonnegative-integer?) #f) #f])
void?]{
Returns the current selection range in @techlink{position}s. If
@ -823,7 +835,7 @@ and @method[text% get-end-position].
@defmethod[(get-region-data [start exact-nonnegative-integer?]
[end exact-nonnegative-integer?])
(or/c (is-a?/c editor-data%) false/c)]{
(or/c (is-a?/c editor-data%) #f)]{
Gets extra data associated with a given region. See
@|editordatadiscuss| for more information.
@ -854,7 +866,7 @@ Returns an inexact number that increments every time the editor is
@defmethod[(get-snip-position [snip (is-a?/c snip%)])
(or/c exact-nonnegative-integer? false/c)]{
(or/c exact-nonnegative-integer? #f)]{
Returns the starting @techlink{position} of a given snip or
@scheme[#f] if the snip is not in this editor.
@ -862,9 +874,9 @@ Returns the starting @techlink{position} of a given snip or
}
@defmethod[(get-snip-position-and-location [snip (is-a?/c snip%)]
[pos (or/c (box/c exact-nonnegative-integer?) false/c)]
[x (or/c (box/c real?) false/c) #f]
[y (or/c (box/c real?) false/c) #f])
[pos (or/c (box/c exact-nonnegative-integer?) #f)]
[x (or/c (box/c real?) #f) #f]
[y (or/c (box/c real?) #f) #f])
boolean?]{
Gets a snip's @techlink{position} and top left @techlink{location} in editor
@ -911,9 +923,9 @@ See also @method[text% set-styles-sticky].
}
@defmethod[(get-tabs [length (or/c (box/c exact-nonnegative-integer?) false/c) #f]
[tab-width (or/c (box/c real?) false/c) #f]
[in-units (or/c (box/c any/c) false/c) #f])
@defmethod[(get-tabs [length (or/c (box/c exact-nonnegative-integer?) #f) #f]
[tab-width (or/c (box/c real?) #f) #f]
[in-units (or/c (box/c any/c) #f) #f])
(listof real?)]{
Returns the current tab-position array as a list.
@ -964,8 +976,8 @@ Returns the distance from the top of the editor to the alignment
}
@defmethod[(get-visible-line-range [start (or/c (box/c exact-nonnegative-integer?) false/c)]
[end (or/c (box/c exact-nonnegative-integer?) false/c)]
@defmethod[(get-visible-line-range [start (or/c (box/c exact-nonnegative-integer?) #f)]
[end (or/c (box/c exact-nonnegative-integer?) #f)]
[all? any/c #t])
void?]{
@ -985,8 +997,8 @@ If the editor is displayed by multiple canvases and @scheme[all?] is
}
@defmethod[(get-visible-position-range [start (or/c (box/c exact-nonnegative-integer?) false/c)]
[end (or/c (box/c exact-nonnegative-integer?) false/c)]
@defmethod[(get-visible-position-range [start (or/c (box/c exact-nonnegative-integer?) #f)]
[end (or/c (box/c exact-nonnegative-integer?) #f)]
[all? any/c #t])
void?]{
@ -1523,7 +1535,9 @@ If the paragraph ends with invisible @techlink{item}s (such as a carriage
@defmethod[(paragraph-start-line [paragraph exact-nonnegative-integer?])
exact-nonnegative-integer?]{
Returns the starting line of a given paragraph. @|ParagraphNumbering| @|LineNumbering|
Returns the starting line of a given paragraph. If @scheme[paragraph]
is greater than the highest-numbered paragraph, then the editor's end
@tech{position} is returned. @|ParagraphNumbering| @|LineNumbering|
@|FCAMW| @|EVD|
@ -1548,13 +1562,17 @@ If the paragraph starts with invisible @techlink{item}s and @scheme[visible?] is
@defmethod[#:mode override
(paste [time (and/c exact? integer?) 0]
[start (or/c exact-nonnegative-integer? (one/of 'end)) 'end]
[start (or/c exact-nonnegative-integer? (one/of 'start 'end)) 'start]
[end (or/c exact-nonnegative-integer? (one/of 'same)) 'same])
void?]{
Pastes into the specified range. If @scheme[start] is @scheme['end], then
the current selection end @techlink{position} is used. If @scheme[end] is
@scheme['same], then @scheme[start] is used for @scheme[end].
Pastes into the specified range. If @scheme[start] is @scheme['start],
then the current selection start @techlink{position} is used. If
@scheme[start] is @scheme['end], then the current selection end
@techlink{position} is used. If @scheme[end] is @scheme['same], then
@scheme[start] is used for @scheme[end], unless @scheme[start] is
@scheme['start], in which case the current selection end
@techlink{position} is used.
See @|timediscuss| for a discussion of the @scheme[time] argument. If
@scheme[time] is outside the platform-specific range of times,
@ -1586,13 +1604,17 @@ If the previous operation on the editor was not a paste, calling
@defmethod[#:mode override
(paste-x-selection [time (and/c exact? integer?)]
[start (or/c exact-nonnegative-integer? (one/of 'end)) 'end]
[start (or/c exact-nonnegative-integer? (one/of 'start 'end)) 'start]
[end (or/c exact-nonnegative-integer? (one/of 'same)) 'same])
void?]{
Pastes into the specified range. If @scheme[start] is @scheme['end], then
the current selection end @techlink{position} is used. If @scheme[end] is
@scheme['same], then @scheme[start] is used for @scheme[end].
Pastes into the specified range. If @scheme[start] is @scheme['start],
then the current selection start @techlink{position} is used. If
@scheme[start] is @scheme['end], then the current selection end
@techlink{position} is used. If @scheme[end] is @scheme['same], then
@scheme[start] is used for @scheme[end], unless @scheme[start] is
@scheme['start], in which case the current selection end
@techlink{position} is used.
See @|timediscuss| for a discussion of the @scheme[time] argument. If
@scheme[time] is outside the platform-specific range of times,
@ -1616,8 +1638,8 @@ See @|ateoldiscuss| for a discussion of @scheme[at-eol?].
@defmethod[(position-location [start exact-nonnegative-integer?]
[x (or/c (box/c real?) false/c) #f]
[y (or/c (box/c real?) false/c) #f]
[x (or/c (box/c real?) #f) #f]
[y (or/c (box/c real?) #f) #f]
[top? any/c #t]
[at-eol? any/c #f]
[whole-line? any/c #f])
@ -1647,10 +1669,10 @@ maximum bottom @techlink{location} for the whole line is returned in @scheme[y].
@defmethod[(position-locations [start exact-nonnegative-integer?]
[top-x (or/c (box/c real?) false/c) #f]
[top-y (or/c (box/c real?) false/c) #f]
[bottom-x (or/c (box/c real?) false/c) #f]
[bottom-y (or/c (box/c real?) false/c) #f]
[top-x (or/c (box/c real?) #f) #f]
[top-y (or/c (box/c real?) #f) #f]
[bottom-x (or/c (box/c real?) #f) #f]
[bottom-y (or/c (box/c real?) #f) #f]
[at-eol? any/c #f]
[whole-line? any/c #f])
void?]{
@ -1750,8 +1772,8 @@ If @scheme[on?] is not @scheme[#f], then the selection will be
}
@defmethod[(set-autowrap-bitmap [bitmap (or/c (is-a?/c bitmap%) false/c)])
(or/c (is-a?/c bitmap%) false/c)]{
@defmethod[(set-autowrap-bitmap [bitmap (or/c (is-a?/c bitmap%) #f)])
(or/c (is-a?/c bitmap%) #f)]{
Sets the bitmap that is drawn at the end of a line when it is
automatically line-wrapped.
@ -1790,7 +1812,7 @@ See also
exact-nonnegative-integer?
exact-nonnegative-integer?)
. -> . any)]
[hilite-delta (or/c (is-a?/c style-delta%) false/c) #f]
[hilite-delta (or/c (is-a?/c style-delta%) #f) #f]
[call-on-down? any/c #f])
void?]{
@ -2010,8 +2032,8 @@ Setting tabs is disallowed when the editor is internally locked for
}
@defmethod[(set-wordbreak-func [f ((is-a?/c text%) (or/c (box/c exact-nonnegative-integer?) false/c)
(or/c (box/c exact-nonnegative-integer?) false/c)
@defmethod[(set-wordbreak-func [f ((is-a?/c text%) (or/c (box/c exact-nonnegative-integer?) #f)
(or/c (box/c exact-nonnegative-integer?) #f)
symbol?
. -> . any)])
void?]{
@ -2036,7 +2058,7 @@ Since the wordbreak function will be called when line breaks are being
}
@defmethod[(set-wordbreak-map [map (or/c (is-a?/c editor-wordbreak-map%) false/c)])
@defmethod[(set-wordbreak-map [map (or/c (is-a?/c editor-wordbreak-map%) #f)])
void?]{
Sets the wordbreaking map that is used by the standard wordbreaking

4
collects/scribblings/guide/proc-macros.scrbl
View File

@ -115,7 +115,7 @@ unwrapping a pair, in which case the @scheme[cdr] of the pair may be
recursively unwrapped, depending on how the syntax object was
constructed.
The oppose of @scheme[syntax->datum] is, of course,
The opposite of @scheme[syntax->datum] is, of course,
@scheme[datum->syntax]. In addition to a datum like @scheme['(+ 1
2)], @scheme[datum->syntax] needs an existing syntax object to donate
its lexical context, and optionally another syntax object to donate
@ -322,7 +322,7 @@ the source form are identifiers. We could use a
]
The @scheme[check-ids] function can use the @scheme[syntax->list]
function to convert a synatx-object wrapping a list into a list
function to convert a syntax-object wrapping a list into a list
of syntax objects:
@schemeblock[

23
collects/scribblings/reference/eval-model.scrbl
View File

@ -563,18 +563,21 @@ If a module @tech{instantiate}d at @tech{phase} @math{n}
first @tech{instantiate}d at phase @math{n}, and so on
transitively. (Module @scheme[require]s cannot form cycles.) If a
module @tech{instantiate}d at phase @math{n} @scheme[require]s
@scheme[for-syntax] another module, the other module is first
@tech{instantiate}d at @tech{phase} @math{n+1}, and so on. If a
module @tech{instantiate}d at phase @math{n} for non-zero @math{n}
@scheme[require]s @scheme[for-template] another module, the other
module is first @tech{instantiate}d at @tech{phase} @math{n-1}, and so
on.
@scheme[for-syntax] another module, the other module becomes
@deftech{available} at @tech{phase} @math{n+1}, and it may later be
@tech{instantiate}d at @tech{phase} @math{n+1}. If a module that is
@tech{available} at phase @math{n} for @math{n>0} @scheme[require]s
@scheme[for-template] another module, the other module becomes
@tech{available} at @tech{phase} @math{n-1}, and so
on. @tech{Instantiation}s of @tech{available} modules above
@tech{phase} 0 are triggered on demand as described in
@secref["mod-parse"].
A final distinction among module @tech{instantiations} is that
multiple @tech{instantiations} may exist at @tech{phase} 1 and higher. These
@tech{instantiations} are created by the parsing of module forms (see
@secref["mod-parse"]), and are, again, conceptually distinguished
by prefixes.
multiple @tech{instantiations} may exist at @tech{phase} 1 and
higher. These @tech{instantiations} are created by the parsing of
module forms (see @secref["mod-parse"]), and are, again, conceptually
distinguished by prefixes.
Top-level variables can exist in multiple phases in the same way as
within modules. For example, @scheme[define-for-syntax] creates a

20
collects/scribblings/reference/hashes.scrbl
View File

@ -47,9 +47,10 @@ a table-specific semaphore as needed. Three caveats apply, however:
@itemize[
@item{If a thread is terminated while applying @scheme[hash-ref],
@scheme[hash-set!], or @scheme[hash-remove!] to a hash table that
@scheme[hash-set!], @scheme[hash-remove!], @scheme[hash-ref!],
or @scheme[has-update!] to a hash table that
uses @scheme[equal?] or @scheme[eqv?] key comparisons, all current
and future operations on the hash table block indefinitely.}
and future operations on the hash table may block indefinitely.}
@item{The @scheme[hash-map] and @scheme[hash-for-each] procedures do
not use the table's semaphore. Consequently, if a hash table is
@ -63,7 +64,8 @@ a table-specific semaphore as needed. Three caveats apply, however:
otherwise the traversal skips a deleted key or uses the remapped
key's new value).}
@item{The @scheme[hash-update!] function uses a table's semaphore
@item{The @scheme[hash-update!] and @scheme[hash-set!] functions
use a table's semaphore
independently for the @scheme[hash-ref] and @scheme[hash-set!] parts
of its functionality, which means that the update as a whole is not
``atomic.''}
@ -209,15 +211,17 @@ Returns the value for @scheme[key] in @scheme[hash]. If no value is
found for @scheme[key], then @scheme[to-set] determines the result as
in @scheme[hash-ref] (i.e., it is either a thunk that computes a value
or a plain value), and this result is stored in @scheme[hash] for the
@scheme[key]. (Note that is @scheme[to-set] is a thunk, it is not
invoked in tail position.)}
@scheme[key]. (Note that if @scheme[to-set] is a thunk, it is not
invoked in tail position.)
@see-also-caveats[]}
@defproc[(hash-has-key? [hash hash?] [key any/c])
any]{
boolean?]{
Returns a true value if @scheme[hash] contains the given
@scheme[key].}
Returns @scheme[#t] if @scheme[hash] contains a value for the given
@scheme[key], @scheme[#f] otherwise.}
@defproc[(hash-update! [hash (and/c hash? (not/c immutable?))]

29
collects/scribblings/reference/module-reflect.scrbl
View File

@ -322,27 +322,29 @@ See also @scheme[module->language-info].}
[fail-thunk (-> any) (lambda () ....)])
any]{
Dynamically instantiates the module specified by @scheme[mod] for
@tech{phase} 0 in the current namespace's registry, if it is not yet
@tech{instantiate}d. The current @tech{module name resolver} may load
a module declaration to resolve @scheme[mod] (see
@scheme[current-module-name-resolver]); the path is resolved relative
to @scheme[current-load-relative-directory] and/or
Dynamically @tech{instantiates} the module specified by @scheme[mod]
in the current namespace's registry at the namespace's @tech{base
phase}, if it is not yet @tech{instantiate}d. The current @tech{module
name resolver} may load a module declaration to resolve @scheme[mod]
(see @scheme[current-module-name-resolver]); the path is resolved
relative to @scheme[current-load-relative-directory] and/or
@scheme[current-directory].
If @scheme[provided] is @scheme[#f], then the result is @|void-const|,
and the module is not @tech{visit}ed (see @secref["mod-parse"]).
and the module is not @tech{visit}ed (see @secref["mod-parse"]) or
even made @tech{available} (for on-demand @tech{visits}) in phases
above the @tech{base phase}.
When @scheme[provided] is a symbol, the value of the module's export
with the given name is returned, and still the module is not
@tech{visit}ed. If the module exports @scheme[provide] as syntax, then
a use of the binding is expanded and evaluated in a fresh namespace to
which the module is attached, which means that the module is
@tech{visit}ed. If the module has no such exported variable or syntax,
then @scheme[fail-thunk] is called; the default @scheme[fail-thunk]
raises @scheme[exn:fail:contract]. If the variable named by
@scheme[provided] is exported protected (see @secref["modprotect"]),
then the @exnraise[exn:fail:contract].
@tech{visit}ed in the fresh namespace. If the module has no such
exported variable or syntax, then @scheme[fail-thunk] is called; the
default @scheme[fail-thunk] raises @scheme[exn:fail:contract]. If the
variable named by @scheme[provided] is exported protected (see
@secref["modprotect"]), then the @exnraise[exn:fail:contract].
If @scheme[provided] is @|void-const|, then the module is
@tech{visit}ed but not @tech{instantiate}d (see @secref["mod-parse"]),
@ -354,7 +356,8 @@ and the result is @|void-const|.}
[fail-thunk (-> any) (lambda () ....)])
any]{
Like @scheme[dynamic-require], but in @tech{phase} 1.}
Like @scheme[dynamic-require], but in a @tech{phase} that is @math{1}
more than the namespace's @tech{base phase}.}
@defproc[(module->language-info [mod module-path?])

16
collects/scribblings/reference/namespaces.scrbl
View File

@ -252,17 +252,17 @@ path, but no module is loaded; the resolved form of @scheme[modname]
is used as the module name in @scheme[dest-namespace]. In addition to
@scheme[modname], every module that it imports (directly or
indirectly) is also recorded in the current namespace's @tech{module
registry}. The inspector of the module invocation in
@scheme[dest-namespace] is the same as inspector of the invocation in
@scheme[src-namespace].
registry}, and instances at the same @tech{phase} or lower are also
attached to @scheme[dest-namespace] (while @tech{visits} at the
module's phase and instances at higher phases are not attached, nor
even made @tech{available} for on-demand @tech{visits}). The inspector
of the module invocation in @scheme[dest-namespace] is the same as
inspector of the invocation in @scheme[src-namespace].
If @scheme[modname] does not refer to an @tech{instantiate}d module in
@scheme[src-namespace], or if the name of any module to be attached
already has a different declaration or instance in
@scheme[dest-namespace], then the @exnraise[exn:fail:contract]. If
the module to attach has not been @tech{visit}ed (see
@secref["mod-parse"]), then it is @tech{visit}ed in the original
namespace before being attached.
already has a different declaration or same-@tech{phase} instance in
@scheme[dest-namespace], then the @exnraise[exn:fail:contract].
If @scheme[src-namespace] and @scheme[dest-namespace] do not have the
same @tech{base phase}, then the @exnraise[exn:fail:contract].}

48
collects/scribblings/reference/syntax-model.scrbl
View File

@ -647,29 +647,46 @@ or @scheme[define-syntaxes] form, expansion fails with a syntax error.
A @scheme[require] form not only introduces @tech{bindings} at
expansion time, but also @deftech{visits} the referenced module when
it is encountered by the expander. That is, the expander
@tech{instantiate}s any @scheme[define-for-syntax]ed variables defined
instantiates any @scheme[define-for-syntax]ed variables defined
in the module, and also evaluates all expressions for
@scheme[define-syntaxes] @tech{transformer bindings}.
Module @tech{visits} propagate through @scheme[require]s in the same
way as module @tech{instantiation}. Moreover, when a module is
@tech{visit}ed, any module that it @scheme[require]s
@scheme[for-syntax] is @tech{instantiate}d at @tech{phase} 1, with the
adjustment that @scheme[require] @scheme[for-template]s leading back
to @tech{phase} 0 causes the required module to be merely visited at
@tech{phase} 0, not @tech{instantiate}d.
@tech{visit}ed at @tech{phase} 0, any module that it @scheme[require]s
@scheme[for-syntax] is @tech{instantiate}d at @tech{phase} 1, while
further @scheme[require]s @scheme[for-template] leading back
to @tech{phase} 0 causes the required module to be visited at
@tech{phase} 0 (i.e., not @tech{instantiate}d).
When the expander encounters @scheme[(require (for-syntax ....))], it
immediately instantiates the required module at @tech{phase} 1, in
addition to adding bindings scheme @tech{phase level} 1 (i.e., the
@tech{transformer environment}).
During compilation, the top-level of module context is itself
implicitly @tech{visit}ed. Thus, when the expander encounters
@scheme[(require (for-syntax ....))], it immediately
@tech{instantiate}s the required module at @tech{phase} 1, in addition
to adding bindings at @tech{phase level} 1 (i.e., the
@tech{transformer environment}). Similarly, the expander immediately
evaluates any @scheme[define-values-for-syntax] form that it
encounters.
@tech{Phases} beyond 0 are @tech{visit}ed on demand. For example,
when the right-hand side of a @tech{phase}-0 @scheme[let-syntax] is to
be expanded, then modules that are @tech{available} at @tech{phase} 1
are visited. More generally, initiating expansion at @tech{phase}
@math{n} @tech{visit}s modules at @tech{phase} @math{n}, which in turn
@tech{instantiates} modules at @tech{phase} @math{n+1}. These
@tech{visits} and @tech{instantiations} apply to @tech{available}
modules in the enclosing @tech{namespace}.
When the expander encounters @scheme[require] and @scheme[(require
(for-syntax ....))] within a @tech{module context}, the resulting
@tech{visits} and @tech{instantiations} are specific to the expansion
of the enclosing module, and are kept separate from @tech{visits} and
@tech{instantiations} triggered from a @tech{top-level context} or
from the expansion of a different module.
from the expansion of a different module. Along the same lines, when a
module is attached to a namespace through
@scheme[namespace-attach-module], modules that it @scheme[require]s
are transitively attached, but instances are attached only at
phases at or below the namespace's @tech{base phase}.
@;------------------------------------------------------------------------
@section[#:tag "compilation-model"]{Compilation}
@ -742,10 +759,11 @@ reflective operations such as @scheme[eval] and
After a namespace is created, module instances from existing
namespaces can be attached to the new namespace. In terms of the
evaluation model, top-level variables from different namespaces
essentially correspond to definitions with different prefixes.
Furthermore, the first step in evaluating any compiled expression is
to link its top-level variable and module-level variable references to
specific variables in the namespace.
essentially correspond to definitions with different prefixes, but
attaching a module uses the same prefix for the module's definitions
in namespaces where it is attached. The first step in evaluating any
compiled expression is to link its top-level variable and module-level
variable references to specific variables in the namespace.
At all times during evaluation, some namespace is designated as the
@deftech{current namespace}. The current namespace has no particular

13
collects/scribblings/reference/syntax.scrbl
View File

@ -272,12 +272,13 @@ Legal only in a @tech{module begin context}, and handled by the
((unsyntax (schemeidfont "+")) nat)
((unsyntax (schemeidfont "-")) nat)])]{
In a @tech{top-level context}, @scheme[require] instantiates modules
(see @secref["module-eval-model"]). In a @tech{module context},
@scheme[require] @tech{visits} modules (see @secref["mod-parse"]). In
both contexts, @scheme[require] introduces bindings into a
@tech{namespace} or a module (see @secref["intro-binding"]).
A @scheme[require] form in a @tech{expression context} or
In a @tech{top-level context}, @scheme[require] @tech{instantiates}
modules (see @secref["module-eval-model"]). In a @tech{top-level
context} or @tech{module context}, expansion of @scheme[require]
@tech{visits} modules (see @secref["mod-parse"]). In both contexts and
both evaluation and expansion, @scheme[require] introduces bindings
into a @tech{namespace} or a module (see @secref["intro-binding"]). A
@scheme[require] form in a @tech{expression context} or
@tech{internal-definition context} is a syntax error.
A @scheme[require-spec] designates a particular set of identifiers to

2
collects/sirmail/readr.ss
View File

@ -2395,7 +2395,9 @@
(send header-list focus)
(send (send header-list get-editor) begin-edit-sequence)
(for-each add-message mailbox)
(send (send header-list get-editor) end-edit-sequence)
(send main-frame create-status-line)

66
collects/tests/mred/media8.mre
View File

@ -1,17 +1,20 @@
#reader(lib"read.ss""wxme")WXME0108 ##
#|
This file is in PLT Scheme editor format.
Open this file in DrScheme version 370 or later to read it.
Open this file in DrScheme version 370 or later to read it.
Most likely, it was created by saving a program in DrScheme version
370 or later, and it probably contains a program with non-text
elements (such as images or comment boxes).
www.plt-scheme.org
Most likely, it was created by saving a program in DrScheme,
and it probably contains a program with non-text elements
(such as images or comment boxes).
http://www.plt-scheme.org
|#
4 7 #"wxtext\0"
3 1 6 #"wxtab\0"
1 1 8 #"wxmedia\0"
3 1 8 #"wximage\0"
4 1 8 #"wximage\0"
2 0 1 6 #"wxloc\0"
00000000000 1 26 0 9 #"Standard\0"
00000000000 1 19 0 9 #"Standard\0"
0 70 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 #"\0"
0 70 1 #"\0"
@ -50,25 +53,11 @@
0 75 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 1 1 1 #"\0"
0 70 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 2 1 1 1 #"\0"
0 71 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1 1 1 #"\0"
0 70 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1 1 1 #"\0"
0 72 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1 1 1 #"\0"
0 73 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1 1 1 #"\0"
0 74 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1 1 1 #"\0"
0 75 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1 1 1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1
00000000002 0 00000000000 2 00000000000 41 0 1 3 44
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 2 1 00000000002
0 00000000000 2 00000000000 40 0 1 3 44
#"This is a line of plain text (default font)."
0 0 1 29 1 #"\n"
0 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 00000000000 2 3 0 9
0 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 0 00000000000 2 3 0 9
#"Standard\0"
0 70 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 #"\0"
@ -76,13 +65,13 @@
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 00000000000
1 0 1 3 38 #"This is a line of plain text in a box."
0 00000000000 0 0 1 29 1 #"\n"
0 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 00000000000 3 3 0 9
0 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 0 00000000000 3 3 0 9
#"Standard\0"
0 70 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 #"\0"
0 70 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 00000000000
1 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 00000000000 4 3 0 9
1 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 0 00000000000 4 3 0 9
#"Standard\0"
0 70 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 #"\0"
@ -97,7 +86,7 @@
0 0 5 3 29 #"This has a yellow background."
0 0 1 29 1 #"\n"
0 0 7 3 34 #"Top aligned (compared to the box)."
0 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 00000000000 5 5 0 9
0 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 0 00000000000 5 5 0 9
#"Standard\0"
0 70 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 #"\0"
@ -112,7 +101,7 @@
0 0 1 29 1 #"\n"
0 0 4 3 3 #"Red"
0 0 4 29 1 #"\n"
0 2 4 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 00000000000 6 4 0 9
0 2 4 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 0 00000000000 6 4 0 9
#"Standard\0"
0 70 1 #"\0"
1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 #"\0"
@ -138,15 +127,14 @@
0 0 7 29 1 #"\n"
0 0 12 3 19 #"(2 points smaller.)"
0 0 7 29 1 #"\n"
0 0 19 3 11 #"Decorative."
0 0 20 3 1 #" "
0 0 21 3 6 #"Roman."
0 0 20 3 1 #" "
0 0 22 3 7 #"Script."
0 0 20 3 1 #" "
0 0 23 3 6 #"Swiss."
0 0 20 3 1 #" "
0 0 24 3 6 #"Fixed."
0 0 25 3 53 #" (Last line changed to bottom-aligned for version 8.)"
0 0 20 29 1 #"\n"
0 0 13 3 11 #"Decorative."
0 0 7 3 1 #" "
0 0 14 3 6 #"Roman."
0 0 7 3 1 #" "
0 0 15 3 7 #"Script."
0 0 7 3 1 #" "
0 0 16 3 6 #"Swiss."
0 0 7 3 1 #" "
0 0 17 3 6 #"Fixed."
0 0 7 29 1 #"\n"
0 00000000000

44
collects/tests/mred/test-editor-admin.ss Normal file
View File

@ -0,0 +1,44 @@
#lang scheme/base
(require scheme/class
scheme/gui/base)
(provide test-editor-admin%)
(define the-dc
(new (class* bitmap-dc% ()
(super-new)
(define/override (get-text-extent s [font #f] [combine? #f] [offset 0])
(values (* 10.0 (string-length s)) 10.0 1.0 1.0))
(define/override (set-pen . p) (void))
(define/override (get-pen . p) #f)
(define/override (set-brush . b) (void))
(define/override (get-brush . b) #f)
(define/override (set-clipping-rect . b) (void))
(define/override (get-clipping-region . b) #f)
(define/override (draw-text s x y combine? offset count) (void))
(define/override (cache-font-metrics-key) 100))))
(define test-editor-admin%
(class editor-admin%
(super-new)
(define/override (get-dc [x #f] [y #f])
(when x (set-box! x 1.0))
(when y (set-box! y 1.0))
the-dc)
(define/private (do-get-view x y w h)
(when x (set-box! x 0.0))
(when y (set-box! y 0.0))
(when w (set-box! w 100.0))
(when h (set-box! h 100.0)))
(define/override (get-view x y w h [full? #f])
(do-get-view x y w h))
(define/override (get-max-view x y w h [full? #f])
(do-get-view x y w h))
(define/override (scroll-to x y w h refresh? bias)
(void))))

1337
collects/tests/mred/wxme.ss Normal file
View File

File diff suppressed because it is too large Load Diff

8
collects/tests/mzscheme/module.ss
View File

@ -176,13 +176,13 @@
(define e 1)
(,here 'e)
(provide e)))
(test '(d c b c) values l)
(test '(d b c) values l)
(eval `(module f mzscheme
(,here 'f)
(require 'b 'e)))
(test '(d c b d c b c) values l)
(test '(d b d b c) values l)
(eval `(require 'f))
(let ([finished '(f b e a d c b d c b d c b c)])
(let ([finished '(f b e a d b d b d b c)])
(test finished values l)
(namespace-attach-module n ''f)
(test finished values l)
@ -192,7 +192,7 @@
(namespace-require 'scheme/base)
(eval `(require 'a))
(eval `(require 'f))
(test finished values l)))))
(test (list* 'd 'b finished) values l)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check redundant import and re-provide

10
doc/release-notes/mzscheme/HISTORY.txt
View File

@ -1,12 +1,14 @@
Version 4.1.5.3
Change provide to convert an exported rename transformer to its
Changed provide to convert an exported rename transformer to its
free-identifier=? target
Add 'not-free-identifier=? syntax property to disable free-identifier=?
Added 'not-free-identifier=? syntax property to disable free-identifier=?
propagation through a rename transformer
Add prop:rename-transformer and prop:set!-transformer
Fix scheme/local so that local syntax bindings are visible to later
Added prop:rename-transformer and prop:set!-transformer
Fixed scheme/local so that local syntax bindings are visible to later
local definitions
Changed current-process-milliseconds to accept a thread argument
Added hash-hash-key?, hash-ref!
Added in-sequences, in-cycle
Version 4.1.5.2
Changed expander to detect a reaname transformer and install a

2
src/configure vendored
View File

@ -12013,7 +12013,7 @@ if test "${enable_mred}" = "yes" ; then
makefiles="$makefiles
mred/Makefile
mred/wxs/Makefile mred/wxme/Makefile
mred/wxs/Makefile
mred/gc2/Makefile"
if test "${enable_libpng}" != "yes" ; then

9
src/mred/Makefile.in
View File

@ -44,7 +44,7 @@ WXINC_wx_xt = -I$(PLTSRCDIR)/wxxt/src/AIAI-include -I$(PLTSRCDIR)/wxxt/src
WXINC_wx_mac = -I$(PLTSRCDIR)/wxmac/include/base -I$(PLTSRCDIR)/wxmac/include/mac -I$(PLTSRCDIR)/wxcommon -I$(PLTSRCDIR)/a-list/c-headers/
WXINC = $(WXINC_@WXVARIANT@)
NOGCINC = $(WXINC) -I$(PLTSRCDIR)/mred/wxme/ -I$(PLTBUILDDIR)/mzscheme/ -I$(PLTSRCDIR)/mzscheme/include/
NOGCINC = $(WXINC) -I$(PLTBUILDDIR)/mzscheme/ -I$(PLTSRCDIR)/mzscheme/include/
INC = -I$(PLTSRCDIR)/mzscheme/$(GCDIRECTORY) $(NOGCINC)
CXXFLAGS = $(INC) $(XINCLUDE) $(OPTIONS) -D$(WXVARIANT) @COMPFLAGS@ @PROFFLAGS@ @CXXFLAGS@ @PREFLAGS@
CFLAGS = $(INC) $(XINCLUDE) $(OPTIONS) -D$(WXVARIANT) @COMPFLAGS@ @PROFFLAGS@ @CFLAGS@ @PREFLAGS@
@ -67,7 +67,7 @@ WXLIBS_wx_xt = ../wxxt/src/libwx_xt.@LIBSFX@ ../wxxt/contrib/xpm/lib/libXpm.@LIB
MREDX_wx_xt = mredx.@LTO@
WXLIBS_wx_mac = ../wxmac/src/libwxmac.@LIBSFX@
MREDX_wx_mac = mredmac.@LTO@ simpledrop.@LTO@
WXLIBSNORM = mred.@LTO@ $(MREDX_@WXVARIANT@) wxGC.@LTO@ wxJPEG.@LTO@ wxs/libwxscheme.@LIBSFX@ wxme/libwxme.@LIBSFX@ $(WXLIBS_@WXVARIANT@) @JPEG_A@ @PNG_A@ @ZLIB_A@
WXLIBSNORM = mred.@LTO@ $(MREDX_@WXVARIANT@) wxGC.@LTO@ wxJPEG.@LTO@ wxs/libwxscheme.@LIBSFX@ $(WXLIBS_@WXVARIANT@) @JPEG_A@ @PNG_A@ @ZLIB_A@
WXLIBSDYN = libmred.@LIBSFX@
GUILIBS_wx_xt = $(LDLIBS)
GUILIBS_wx_mac = @LIBS@
@ -81,7 +81,6 @@ MREDOBJECTS = mrmain.@LTO@
MZSCHEMEDEPS = ../mzscheme/libmzscheme.@LIBSFX@ ../mzscheme/libmzgc.@LIBSFX@
WXSCHEME = wxs/libwxscheme.@LIBSFX@
WXME = wxme/libwxme.@LIBSFX@
INSTALLDEST=/home/scheme/plt
@ -113,7 +112,6 @@ cgc:
$(MAKE) ext-libs
$(MAKE) @WXVARIANT@
cd wxs; $(MAKE)
cd wxme; $(MAKE)
$(MAKE) $(LINKRESULT)
both:
@ -171,7 +169,7 @@ wx_mac:
wx_mac-min:
cd ../wxmac/src; $(MAKE) min
mred.@LTO@ : $(srcdir)/mred.cxx $(srcdir)/wxme/wx_media.h $(srcdir)/wxme/wx_medad.h \
mred.@LTO@ : $(srcdir)/mred.cxx \
$(srcdir)/wxs/wxscheme.h $(srcdir)/mred.h \
$(srcdir)/../mzscheme/include/scheme.h \
$(srcdir)/wxs/wxsmred.h $(WXINCDEP) $(srcdir)/../wxcommon/wxGC.h \
@ -238,7 +236,6 @@ clean:
rm -f *.@LTO@ *.d core mred mred3m
rm -f gc2/*.@LTO@ gc2/xsrc/* gc2/macxsrc/* gc2/*.d gc2/*.dd
rm -rf gc2/xform-collects
cd wxme; $(MAKE) clean
cd wxs; $(MAKE) clean
if [ -f ../wxcommon/jpeg/Makefile ] ; then cd ../wxcommon/jpeg; $(MAKE) clean ; fi
if [ -f ../wxcommon/libpng/Makefile ] ; then cd ../wxcommon/libpng; $(MAKE) clean ; fi

150
src/mred/gc2/Makefile.in
View File

@ -40,7 +40,7 @@ WXINC_wx_xt = -I$(PLTSRCDIR)/wxxt/src/AIAI-include -I$(PLTSRCDIR)/wxxt/src
WXINC_wx_mac = -I$(PLTSRCDIR)/wxmac/include/base -I$(PLTSRCDIR)/wxmac/include/mac -I$(PLTSRCDIR)/wxcommon -I$(PLTSRCDIR)/a-list/c-headers/
WXINC = $(WXINC_@WXVARIANT@)
NOGCINC = $(WXINC) -I$(PLTSRCDIR)/mred/wxme/ -I$(PLTBUILDDIR)/mzscheme/ -I$(PLTSRCDIR)/mzscheme/include/
NOGCINC = $(WXINC) -I$(PLTBUILDDIR)/mzscheme/ -I$(PLTSRCDIR)/mzscheme/include/
INC = -I$(PLTSRCDIR)/mzscheme/$(GCDIRECTORY) $(NOGCINC)
CXXFLAGS = $(INC) $(XINCLUDE) $(OPTIONS) -D$(WXVARIANT) @COMPFLAGS@ @PROFFLAGS@ @CXXFLAGS@ @PREFLAGS@
CFLAGS = $(INC) $(XINCLUDE) $(OPTIONS) -D$(WXVARIANT) @COMPFLAGS@ @PROFFLAGS@ @CFLAGS@ @PREFLAGS@
@ -74,7 +74,7 @@ XFORMDEP = $(srcdir)/../../mzscheme/gc2/xform.ss $(srcdir)/../../mzscheme/gc2/xf
WXBDIR=../../wxxt
WXMACBDIR=../../wxmac/src
MREDLDFLAGS = -L$(WXBDIR)/utils/image/src -L$(WXBDIR)/contrib/xpm/lib $(LDFLAGS) -L../../mzscheme -L../wxs -L../wxme -L$(WXBDIR)/src
MREDLDFLAGS = -L$(WXBDIR)/utils/image/src -L$(WXBDIR)/contrib/xpm/lib $(LDFLAGS) -L../../mzscheme -L../wxs -L$(WXBDIR)/src
DEF_COLLECTS_DIR = +D INITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../../collects; pwd`"'"'
@ -367,43 +367,6 @@ wx_mac_XFORMPRECOMP = $(MACXPRECOMPDEP)
XFORMPRECOMP = $(@WXVARIANT@_XFORMPRECOMP)
XFORMPRECOMPDEP =
xsrc/wx_media.cc: $(srcdir)/../wxme/wx_media.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wx_media.cc $(srcdir)/../wxme/wx_media.cxx
xsrc/wx_mpriv.cc: $(srcdir)/../wxme/wx_mpriv.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wx_mpriv.cc $(srcdir)/../wxme/wx_mpriv.cxx
xsrc/wx_snip.cc: $(srcdir)/../wxme/wx_snip.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wx_snip.cc $(srcdir)/../wxme/wx_snip.cxx
xsrc/wx_msnip.cc: $(srcdir)/../wxme/wx_msnip.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wx_msnip.cc $(srcdir)/../wxme/wx_msnip.cxx
xsrc/wx_mbuf.cc: $(srcdir)/../wxme/wx_mbuf.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wx_mbuf.cc $(srcdir)/../wxme/wx_mbuf.cxx
xsrc/wx_mpbrd.cc: $(srcdir)/../wxme/wx_mpbrd.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wx_mpbrd.cc $(srcdir)/../wxme/wx_mpbrd.cxx
xsrc/wx_keym.cc: $(srcdir)/../wxme/wx_keym.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wx_keym.cc $(srcdir)/../wxme/wx_keym.cxx
xsrc/wx_medio.cc: $(srcdir)/../wxme/wx_medio.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wx_medio.cc $(srcdir)/../wxme/wx_medio.cxx
xsrc/wx_medad.cc: $(srcdir)/../wxme/wx_medad.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wx_medad.cc $(srcdir)/../wxme/wx_medad.cxx
xsrc/wx_style.cc: $(srcdir)/../wxme/wx_style.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wx_style.cc $(srcdir)/../wxme/wx_style.cxx
xsrc/wx_mline.cc: $(srcdir)/../wxme/wx_mline.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wx_mline.cc $(srcdir)/../wxme/wx_mline.cxx
xsrc/wx_cgrec.cc: $(srcdir)/../wxme/wx_cgrec.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wx_cgrec.cc $(srcdir)/../wxme/wx_cgrec.cxx
xsrc/wxscheme.cc: $(srcdir)/../wxs/wxscheme.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxscheme.cc $(srcdir)/../wxs/wxscheme.cxx
@ -448,20 +411,10 @@ xsrc/wxs_item.cc: $(srcdir)/../wxs/wxs_item.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_item.cc $(srcdir)/../wxs/wxs_item.cxx
xsrc/wxs_lbox.cc: $(srcdir)/../wxs/wxs_lbox.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_lbox.cc $(srcdir)/../wxs/wxs_lbox.cxx
xsrc/wxs_madm.cc: $(srcdir)/../wxs/wxs_madm.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_madm.cc $(srcdir)/../wxs/wxs_madm.cxx
xsrc/wxs_mede.cc: $(srcdir)/../wxs/wxs_mede.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_mede.cc $(srcdir)/../wxs/wxs_mede.cxx
xsrc/wxs_medi.cc: $(srcdir)/../wxs/wxs_medi.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_medi.cc $(srcdir)/../wxs/wxs_medi.cxx
xsrc/wxs_menu.cc: $(srcdir)/../wxs/wxs_menu.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_menu.cc $(srcdir)/../wxs/wxs_menu.cxx
xsrc/wxs_mio.cc: $(srcdir)/../wxs/wxs_mio.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_mio.cc $(srcdir)/../wxs/wxs_mio.cxx
xsrc/wxs_misc.cc: $(srcdir)/../wxs/wxs_misc.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_misc.cc $(srcdir)/../wxs/wxs_misc.cxx
xsrc/wxs_mpb.cc: $(srcdir)/../wxs/wxs_mpb.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_mpb.cc $(srcdir)/../wxs/wxs_mpb.cxx
xsrc/wxs_obj.cc: $(srcdir)/../wxs/wxs_obj.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_obj.cc $(srcdir)/../wxs/wxs_obj.cxx
xsrc/wxs_panl.cc: $(srcdir)/../wxs/wxs_panl.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
@ -470,10 +423,6 @@ xsrc/wxs_rado.cc: $(srcdir)/../wxs/wxs_rado.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_rado.cc $(srcdir)/../wxs/wxs_rado.cxx
xsrc/wxs_slid.cc: $(srcdir)/../wxs/wxs_slid.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_slid.cc $(srcdir)/../wxs/wxs_slid.cxx
xsrc/wxs_snip.cc: $(srcdir)/../wxs/wxs_snip.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_snip.cc $(srcdir)/../wxs/wxs_snip.cxx
xsrc/wxs_styl.cc: $(srcdir)/../wxs/wxs_styl.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_styl.cc $(srcdir)/../wxs/wxs_styl.cxx
xsrc/wxs_tabc.cc: $(srcdir)/../wxs/wxs_tabc.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
$(XFORMWP) xsrc/wxs_tabc.cc $(srcdir)/../wxs/wxs_tabc.cxx
xsrc/wxs_win.cc: $(srcdir)/../wxs/wxs_win.cxx $(XFORMDEP) $(XFORMPRECOMPDEP)
@ -769,31 +718,6 @@ wx_xt_EXTRAFLAGS =
wx_mac_EXTRAFLAGS = $(MACUSEPRECOMP) -Imacxsrc
EXTRAFLAGS = $(@WXVARIANT@_EXTRAFLAGS)
wx_media.@LTO@: xsrc/wx_media.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wx_media.@LTO@ xsrc/wx_media.cc
wx_mpriv.@LTO@: xsrc/wx_mpriv.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wx_mpriv.@LTO@ xsrc/wx_mpriv.cc
wx_snip.@LTO@: xsrc/wx_snip.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wx_snip.@LTO@ xsrc/wx_snip.cc
wx_msnip.@LTO@: xsrc/wx_msnip.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wx_msnip.@LTO@ xsrc/wx_msnip.cc
wx_mbuf.@LTO@: xsrc/wx_mbuf.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wx_mbuf.@LTO@ xsrc/wx_mbuf.cc
wx_mpbrd.@LTO@: xsrc/wx_mpbrd.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wx_mpbrd.@LTO@ xsrc/wx_mpbrd.cc
wx_keym.@LTO@: xsrc/wx_keym.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wx_keym.@LTO@ xsrc/wx_keym.cc
wx_medio.@LTO@: xsrc/wx_medio.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wx_medio.@LTO@ xsrc/wx_medio.cc
wx_medad.@LTO@: xsrc/wx_medad.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wx_medad.@LTO@ xsrc/wx_medad.cc
wx_style.@LTO@: xsrc/wx_style.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wx_style.@LTO@ xsrc/wx_style.cc
wx_mline.@LTO@: xsrc/wx_mline.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wx_mline.@LTO@ xsrc/wx_mline.cc
wx_cgrec.@LTO@: xsrc/wx_cgrec.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wx_cgrec.@LTO@ xsrc/wx_cgrec.cc
wxscheme.@LTO@: xsrc/wxscheme.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxscheme.@LTO@ xsrc/wxscheme.cc
wxs_bmap.@LTO@: xsrc/wxs_bmap.cc $(PRECOMPDEP)
@ -822,20 +746,10 @@ wxs_item.@LTO@: xsrc/wxs_item.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_item.@LTO@ xsrc/wxs_item.cc
wxs_lbox.@LTO@: xsrc/wxs_lbox.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_lbox.@LTO@ xsrc/wxs_lbox.cc
wxs_madm.@LTO@: xsrc/wxs_madm.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_madm.@LTO@ xsrc/wxs_madm.cc
wxs_mede.@LTO@: xsrc/wxs_mede.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_mede.@LTO@ xsrc/wxs_mede.cc
wxs_medi.@LTO@: xsrc/wxs_medi.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_medi.@LTO@ xsrc/wxs_medi.cc
wxs_menu.@LTO@: xsrc/wxs_menu.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_menu.@LTO@ xsrc/wxs_menu.cc
wxs_mio.@LTO@: xsrc/wxs_mio.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_mio.@LTO@ xsrc/wxs_mio.cc
wxs_misc.@LTO@: xsrc/wxs_misc.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_misc.@LTO@ xsrc/wxs_misc.cc
wxs_mpb.@LTO@: xsrc/wxs_mpb.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_mpb.@LTO@ xsrc/wxs_mpb.cc
wxs_obj.@LTO@: xsrc/wxs_obj.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_obj.@LTO@ xsrc/wxs_obj.cc
wxs_panl.@LTO@: xsrc/wxs_panl.cc $(PRECOMPDEP)
@ -844,10 +758,6 @@ wxs_rado.@LTO@: xsrc/wxs_rado.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_rado.@LTO@ xsrc/wxs_rado.cc
wxs_slid.@LTO@: xsrc/wxs_slid.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_slid.@LTO@ xsrc/wxs_slid.cc
wxs_snip.@LTO@: xsrc/wxs_snip.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_snip.@LTO@ xsrc/wxs_snip.cc
wxs_styl.@LTO@: xsrc/wxs_styl.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_styl.@LTO@ xsrc/wxs_styl.cc
wxs_tabc.@LTO@: xsrc/wxs_tabc.cc $(PRECOMPDEP)
$(CXX) $(EXTRAFLAGS) -DGC2_JUST_MACROS $(GCPREINC) -c $(XXPOSTFLAGS) -o wxs_tabc.@LTO@ xsrc/wxs_tabc.cc
wxs_win.@LTO@: xsrc/wxs_win.cc $(PRECOMPDEP)
@ -1033,36 +943,16 @@ MRED_XSRCS = \
xsrc/wxs_glob.cc \
xsrc/wxs_item.cc \
xsrc/wxs_lbox.cc \
xsrc/wxs_madm.cc \
xsrc/wxs_mede.cc \
xsrc/wxs_medi.cc \
xsrc/wxs_menu.cc \
xsrc/wxs_mio.cc \
xsrc/wxs_misc.cc \
xsrc/wxs_mpb.cc \
xsrc/wxs_obj.cc \
xsrc/wxs_panl.cc \
xsrc/wxs_rado.cc \
xsrc/wxs_slid.cc \
xsrc/wxs_snip.cc \
xsrc/wxs_styl.cc \
xsrc/wxs_tabc.cc \
xsrc/wxs_win.cc \
\
xsrc/wxscheme.cc \
\
xsrc/wx_media.cc \
xsrc/wx_mpriv.cc \
xsrc/wx_snip.cc \
xsrc/wx_msnip.cc \
xsrc/wx_mbuf.cc \
xsrc/wx_mpbrd.cc \
xsrc/wx_keym.cc \
xsrc/wx_medio.cc \
xsrc/wx_medad.cc \
xsrc/wx_style.cc \
xsrc/wx_mline.cc \
xsrc/wx_cgrec.cc \
\
xsrc/wxJPEG.cc \
\
@ -1230,36 +1120,16 @@ MRED_XOBJS = \
wxs_glob.@LTO@ \
wxs_item.@LTO@ \
wxs_lbox.@LTO@ \
wxs_madm.@LTO@ \
wxs_mede.@LTO@ \
wxs_medi.@LTO@ \
wxs_menu.@LTO@ \
wxs_mio.@LTO@ \
wxs_misc.@LTO@ \
wxs_mpb.@LTO@ \
wxs_obj.@LTO@ \
wxs_panl.@LTO@ \
wxs_rado.@LTO@ \
wxs_slid.@LTO@ \
wxs_snip.@LTO@ \
wxs_styl.@LTO@ \
wxs_tabc.@LTO@ \
wxs_win.@LTO@ \
\
wxscheme.@LTO@ \
\
wx_media.@LTO@ \
wx_mpriv.@LTO@ \
wx_snip.@LTO@ \
wx_msnip.@LTO@ \
wx_mbuf.@LTO@ \
wx_mpbrd.@LTO@ \
wx_keym.@LTO@ \
wx_medio.@LTO@ \
wx_medad.@LTO@ \
wx_style.@LTO@ \
wx_mline.@LTO@ \
wx_cgrec.@LTO@ \
\
wxJPEG.@LTO@ \
\
@ -1540,15 +1410,6 @@ gen-deps:
@INCLUDEDEP@ wx_style.dd
@INCLUDEDEP@ wx_keym.dd
@INCLUDEDEP@ wx_mbuf.dd
@INCLUDEDEP@ wx_media.dd
@INCLUDEDEP@ wx_mpriv.dd
@INCLUDEDEP@ wx_msnip.dd
@INCLUDEDEP@ wx_mline.dd
@INCLUDEDEP@ wx_mpbrd.dd
@INCLUDEDEP@ wx_medad.dd
@INCLUDEDEP@ wx_snip.dd
@INCLUDEDEP@ wx_cgrec.dd
@INCLUDEDEP@ wx_medio.dd
@INCLUDEDEP@ xcglue.dd
@INCLUDEDEP@ wxs_bmap.dd
@INCLUDEDEP@ wxs_butn.dd
@ -1563,19 +1424,12 @@ gen-deps:
@INCLUDEDEP@ wxs_glob.dd
@INCLUDEDEP@ wxs_item.dd
@INCLUDEDEP@ wxs_lbox.dd
@INCLUDEDEP@ wxs_madm.dd
@INCLUDEDEP@ wxs_mede.dd
@INCLUDEDEP@ wxs_medi.dd
@INCLUDEDEP@ wxs_menu.dd
@INCLUDEDEP@ wxs_mio.dd
@INCLUDEDEP@ wxs_misc.dd
@INCLUDEDEP@ wxs_mpb.dd
@INCLUDEDEP@ wxs_obj.dd
@INCLUDEDEP@ wxs_panl.dd
@INCLUDEDEP@ wxs_rado.dd
@INCLUDEDEP@ wxs_slid.dd
@INCLUDEDEP@ wxs_snip.dd
@INCLUDEDEP@ wxs_styl.dd
@INCLUDEDEP@ wxs_tabc.dd
@INCLUDEDEP@ wxs_win.dd
@INCLUDEDEP@ wxscheme.dd

470
src/mred/mred.cxx
View File

@ -29,7 +29,6 @@
#include "wx_buttn.h"
#include "wx_messg.h"
#include "wx_timer.h"
#include "wx_media.h"
#include "wx_dialg.h"
#include "wx_cmdlg.h"
#include "wx_menu.h"
@ -116,7 +115,6 @@ wxFrame *mred_real_main_frame;
static Scheme_Thread *user_main_thread;
extern void wxMediaIOCheckLSB(void);
extern void wxMouseEventHandled(void);
#ifdef wx_xt
extern int wx_single_instance;
@ -296,8 +294,6 @@ static int mark_eventspace_val(void *p)
gcMARK_TYPED(MrEdFinalizedContext *, c->finalized);
gcMARK_TYPED(wxChildList *, c->topLevelWindowList);
gcMARK_TYPED(wxStandardSnipClassList *, c->snipClassList);
gcMARK_TYPED(wxBufferDataClassList *, c->bufferDataClassList);
gcMARK_TYPED(wxWindow *, c->modal_window);
gcMARK_TYPED(MrEd_Saved_Modal *, c->modal_stack);
@ -330,8 +326,6 @@ static int fixup_eventspace_val(void *p)
gcFIXUP_TYPED(MrEdFinalizedContext *, c->finalized);
gcFIXUP_TYPED(wxChildList *, c->topLevelWindowList);
gcFIXUP_TYPED(wxStandardSnipClassList *, c->snipClassList);
gcFIXUP_TYPED(wxBufferDataClassList *, c->bufferDataClassList);
gcFIXUP_TYPED(wxWindow *, c->modal_window);
gcFIXUP_TYPED(MrEd_Saved_Modal *, c->modal_stack);
@ -523,22 +517,6 @@ void wxPopModalWindow(wxObject *w, wxWindow *win)
}
}
wxStandardSnipClassList *wxGetTheSnipClassList()
{
MrEdContext *c;
c = MrEdGetContext();
return c->snipClassList;
}
wxBufferDataClassList *wxGetTheBufferDataClassList()
{
MrEdContext *c;
c = MrEdGetContext();
return c->bufferDataClassList;
}
int wxGetBusyState(void)
{
MrEdContext *c;
@ -739,8 +717,6 @@ static MrEdContext *MakeContext(MrEdContext *c)
if (!c) {
wxChildList *tlwl;
wxStandardSnipClassList *scl;
wxBufferDataClassList *bdcl;
MrEdFinalizedContext *fc;
c = (MrEdContext *)scheme_malloc_tagged(sizeof(MrEdContext));
@ -748,10 +724,6 @@ static MrEdContext *MakeContext(MrEdContext *c)
tlwl = new WXGC_PTRS wxChildList();
c->topLevelWindowList = tlwl;
scl = wxMakeTheSnipClassList();
c->snipClassList = scl;
bdcl = wxMakeTheBufferDataClassList();
c->bufferDataClassList = bdcl;
fc = new WXGC_PTRS MrEdFinalizedContext;
c->finalized = fc;
}
@ -1638,27 +1610,11 @@ static int check_initialized(Scheme_Object *)
# define KEEP_GOING wxTheApp->keep_going
#if WINDOW_STDIO
static Scheme_Custodian *main_custodian;
#endif
void wxDoEvents()
{
/* When we get here, we are in the main dispatcher thread */
if (!TheMrEdApp->initialized) {
MrEdContext *c;
#if WINDOW_STDIO
Scheme_Custodian *m, *oldm = NULL;
Scheme_Config *config = NULL;
if (!wx_in_terminal) {
config = scheme_current_config();
oldm = (Scheme_Custodian *)scheme_get_param(config, MZCONFIG_CUSTODIAN);
m = scheme_make_custodian(oldm);
scheme_set_param(config, MZCONFIG_CUSTODIAN, (Scheme_Object *)m);
wxREGGLOB(main_custodian);
main_custodian = m;
}
#endif
/* Create the user's main thread: */
@ -1681,11 +1637,6 @@ void wxDoEvents()
user_main_thread->name = cp;
}
#if WINDOW_STDIO
if (!wx_in_terminal)
scheme_set_param(config, MZCONFIG_CUSTODIAN, (Scheme_Object *)oldm);
#endif
/* Block until the user's main thread is initialized: */
scheme_block_until(CAST_BLKCHK check_initialized, NULL, NULL, 0.0);
}
@ -2255,235 +2206,11 @@ void MrEdQueueInEventspace(void *context, Scheme_Object *thunk)
/* Redirected Standard I/O */
/****************************************************************************/
#if REDIRECT_STDIO || WINDOW_STDIO || WCONSOLE_STDIO
#if REDIRECT_STDIO || WCONSOLE_STDIO
static void MrEdSchemeMessages(char *, ...);
static Scheme_Object *stdin_pipe;
#endif
#if WINDOW_STDIO
static int have_stdio = 0;
static int stdio_kills_prog = 0;
static Bool RecordInput(void *media, wxEvent *event, void *data);
static Bool SendBreak(void *media, wxEvent *event, void *data);
static void break_console_reading_threads();
static char utf8_leftover[8];
static int utf8_leftover_count;
class IOMediaEdit : public wxMediaEdit
{
public:
Bool CanInsert(long start, long);
Bool CanDelete(long start, long);
};
class IOFrame : public wxFrame
{
public:
wxMediaCanvas *display;
wxMediaEdit *media;
wxMenu *fileMenu;
Bool hidden, beginEditSeq;
int endpos;
IOFrame();
void OnSize(int x, int y);
Bool OnClose(void);
void OnMenuCommand(long id);
Bool PreOnChar(wxWindow *, wxKeyEvent *e);
Bool PreOnEvent(wxWindow *, wxMouseEvent *e);
void CloseIsQuit(void);
};
IOFrame::IOFrame()
: wxFrame(NULL, "Standard Output", -1, -1, 600, 400, 0, "stdout")
{
wxKeymap *km;
wxStyle *style;
wxStyleList *sl;
wxStyleDelta *sd;
wxMenuBar *mb;
wxMenu *m;
display = new WXGC_PTRS wxMediaCanvas(this);
media = new WXGC_PTRS IOMediaEdit();
display->SetMedia(media);
endpos = 0;
hidden = FALSE;
/* Map copy keys: */
km = media->GetKeymap();
media->AddBufferFunctions(km);
media->AddEditorFunctions(km);
km->AddFunction("send-break", SendBreak, NULL);
# ifdef wx_msw
km->MapFunction("c:c", "copy-clipboard");
km->MapFunction("c:x", "copy-clipboard");
km->MapFunction("c:v", "paste-clipboard");
# else
km->MapFunction("d:c", "copy-clipboard");
km->MapFunction("d:x", "copy-clipboard");
km->MapFunction("d:v", "paste-clipboard");
km->MapFunction("d:.", "send-break");
# endif
km->MapFunction("return", "record-input");
km->AddFunction("record-input", RecordInput, NULL);
/* Fixed-width font: */
sl = media->GetStyleList();
style = sl->FindNamedStyle("Standard");
sd = new WXGC_PTRS wxStyleDelta(wxCHANGE_FAMILY, wxMODERN);
style->SetDelta(sd);
#ifdef wx_mac
OnSize(600, 400);
#endif
#ifdef wx_mac
# define CLOSE_MENU_ITEM "Close\tCmd+W"
#else
# define CLOSE_MENU_ITEM "Close"
#endif
mb = new WXGC_PTRS wxMenuBar();
SetMenuBar(mb);
fileMenu = new WXGC_PTRS wxMenu();
fileMenu->Append(77, CLOSE_MENU_ITEM);
m = new WXGC_PTRS wxMenu();
m->Append(79, "&Copy\tCmd+C");
m->Append(81, "&Paste\tCmd+V");
m->AppendSeparator();
m->Append(83, "&Break\tCmd+.");
mb->Append(fileMenu, "File");
mb->Append(m, "Edit");
have_stdio = 1;
Show(TRUE);
beginEditSeq = 0;
}
void IOFrame::OnSize(int x, int y)
{
GetClientSize(&x, &y);
if (display)
display->SetSize(0, 0, x, y);
if (media && (x > 30))
media->SetMaxWidth((float)(x - 30));
}
Bool IOFrame::OnClose(void)
{
hidden = TRUE;
if (stdio_kills_prog) {
if (scheme_exit)
scheme_exit(exit_val);
#ifdef wx_msw
mred_clean_up_gdi_objects();
#endif
scheme_immediate_exit(exit_val);
} else {
break_console_reading_threads();
have_stdio = 0;
}
return TRUE;
}
void IOFrame::OnMenuCommand(long id)
{
if (id == 79)
media->Copy();
else if (id == 81)
media->Paste();
else if (id == 83)
scheme_break_main_thread();
else if (id == 77)
if (OnClose())
Show(FALSE);
}
Bool IOFrame::PreOnChar(wxWindow *, wxKeyEvent *e)
{
PreOnEvent(NULL, NULL);
#if defined(wx_mac) && WINDOW_STDIO
if (e->metaDown && e->KeyCode() == (stdio_kills_prog ? 'q' : 'w')) {
OnMenuCommand(77);
return TRUE;
}
#endif
return FALSE;
}
Bool IOFrame::PreOnEvent(wxWindow *, wxMouseEvent *e)
{
if (beginEditSeq) {
beginEditSeq = 0;
media->EndEditSequence();
}
return FALSE;
}
void IOFrame::CloseIsQuit(void)
{
#ifdef wx_mac
# define QUIT_MENU_ITEM "Quit\tCmd+Q"
#else
# define QUIT_MENU_ITEM "E&xit"
#endif
fileMenu->Delete(77);
fileMenu->Append(77, QUIT_MENU_ITEM);
media->Insert("\n[Exited]", media->LastPosition());
if (beginEditSeq) {
beginEditSeq = 0;
media->EndEditSequence();
}
media->Lock(1);
}
static IOFrame *ioFrame = NULL;
Bool IOMediaEdit::CanInsert(long start, long)
{
return (start >= ioFrame->endpos);
}
Bool IOMediaEdit::CanDelete(long start, long)
{
return (start >= ioFrame->endpos);
}
static Bool RecordInput(void *m, wxEvent *event, void *data)
{
char *s;
long len, start;
wxMediaEdit *media = ioFrame->media;
media->Insert("\n");
start = media->GetStartPosition();
len = start - ioFrame->endpos;
if (len > 0) {
s = media->GetTextUTF8(ioFrame->endpos, start);
ioFrame->endpos = start;
scheme_write_byte_string(s, len, stdin_pipe);
}
return TRUE;
}
static Bool SendBreak(void *m, wxEvent *event, void *data)
{
scheme_break_main_thread();
return TRUE;
}
#else /* !WINDOW_STDIO */
#if WCONSOLE_STDIO
static HANDLE console_out;
@ -2498,66 +2225,15 @@ static FILE *mrerr = NULL;
#endif /* WCONSOLE_STDIO */
#endif /* WINDOW_STDIO */
#if REDIRECT_STDIO || WINDOW_STDIO || WCONSOLE_STDIO
#if REDIRECT_STDIO || WCONSOLE_STDIO
static void MrEdSchemeMessages(char *msg, ...)
{
GC_CAN_IGNORE va_list args;
#if WINDOW_STDIO
char *arg_s = NULL;
long arg_d = 0, arg_l = 0;
# define VSP_BUFFER_SIZE 4096
char arg_buffer[VSP_BUFFER_SIZE];
#endif
scheme_start_atomic();
HIDE_FROM_XFORM(va_start(args, msg));
#if WINDOW_STDIO
if (!wx_in_terminal) {
static int opening = 0;
if (opening) {
HIDE_FROM_XFORM(va_end(args));
return;
}
/* Need to extract arguments before a potential GC */
if (!msg) {
arg_s = HIDE_FROM_XFORM(va_arg(args, char*));
arg_d = HIDE_FROM_XFORM(va_arg(args, long));
arg_l = HIDE_FROM_XFORM(va_arg(args, long));
} else {
# ifdef MPW_CPLUS
/* FIXME: No vsnprintf in MPW. */
# define vsnprintf(x, y, z, w) vsprintf(x, z, w)
# endif
MSC_IZE(vsnprintf)(arg_buffer, VSP_BUFFER_SIZE, msg, args);
}
opening = 1;
if (!ioFrame) {
wxREGGLOB(ioFrame);
if (mred_only_context)
ioFrame = new WXGC_PTRS IOFrame;
else {
/* Set eventspace ... */
mred_only_context = mred_main_context;
only_context_just_once = 1;
ioFrame = new WXGC_PTRS IOFrame;
mred_only_context = NULL;
}
}
opening = 0;
if (ioFrame->hidden) {
ioFrame->hidden = FALSE;
have_stdio = 1;
ioFrame->Show(TRUE);
}
}
#endif
#if WCONSOLE_STDIO
if (!console_out) {
AllocConsole();
@ -2574,60 +2250,6 @@ static void MrEdSchemeMessages(char *msg, ...)
}
#endif
#if WINDOW_STDIO
if (wx_in_terminal) {
vfprintf(stderr, msg, args);
fflush(stderr);
} else if (!msg) {
char *s;
wxchar *us;
long d, l, ulen, ipos;
s = arg_s;
d = arg_d;
l = arg_l;
if (!ioFrame->beginEditSeq) {
ioFrame->media->BeginEditSequence();
ioFrame->beginEditSeq = 1;
}
if (utf8_leftover_count) {
char *naya;
naya = new WXGC_ATOMIC char[l + utf8_leftover_count];
memcpy(naya, utf8_leftover, utf8_leftover_count);
memcpy(naya + utf8_leftover_count, s + d, l);
s = naya;
d = 0;
l += utf8_leftover_count;
}
ulen = scheme_utf8_decode_as_prefix((unsigned char *)s, d, l,
NULL, 0, -1,
&ipos, 0, '?');
utf8_leftover_count = (l - (ipos - d));
memcpy(utf8_leftover, s + ipos, utf8_leftover_count);
us = (wxchar *)scheme_malloc_atomic(sizeof(wxchar) * ulen);
scheme_utf8_decode_as_prefix((unsigned char *)s, d, l,
us, 0, -1,
&ipos, 0, '?');
ioFrame->media->Insert(ulen, us, ioFrame->endpos);
ioFrame->endpos += ulen;
if (ulen != 1 || s[0] == '\n') {
ioFrame->media->EndEditSequence();
ioFrame->beginEditSeq = 0;
}
} else {
ioFrame->media->Insert((char *)arg_buffer, ioFrame->endpos);
ioFrame->endpos += strlen(arg_buffer);
if (ioFrame->beginEditSeq) {
ioFrame->media->EndEditSequence();
ioFrame->beginEditSeq = 0;
}
}
#endif
#if WCONSOLE_STDIO
if (!msg) {
char *s;
@ -2645,7 +2267,7 @@ static void MrEdSchemeMessages(char *msg, ...)
WriteConsole(console_out, buffer, strlen(buffer), &wrote, NULL);
}
#endif
#if !WINDOW_STDIO && !WCONSOLE_STDIO
#if !WCONSOLE_STDIO
vfprintf(mrerr, msg, args);
fflush(mrerr);
#endif
@ -2662,7 +2284,7 @@ static void MrEdSchemeMessagesOutput(char *s, long l)
}
#endif
#if REDIRECT_STDIO || WINDOW_STDIO || WCONSOLE_STDIO
#if REDIRECT_STDIO || WCONSOLE_STDIO
static Scheme_Object *console_reading;
@ -2769,7 +2391,7 @@ static Scheme_Object *MrEdMakeStdIn(void)
static long stdout_write(Scheme_Output_Port*, const char *s, long d, long l,
int rarely_block, int enable_break)
{
#if WINDOW_STDIO || WCONSOLE_STDIO
#if WCONSOLE_STDIO
if (l)
MrEdSchemeMessages(NULL, s, d, l);
#else
@ -2800,7 +2422,7 @@ static Scheme_Object *MrEdMakeStdOut(void)
static long stderr_write(Scheme_Output_Port*, const char *s, long d, long l,
int rarely_block, int enable_break)
{
#if WINDOW_STDIO || WCONSOLE_STDIO
#if WCONSOLE_STDIO
if (l)
MrEdSchemeMessages(NULL, s, d, l);
#else
@ -2849,7 +2471,7 @@ extern "C" GC_word GC_fo_entries;
Scheme_Object *OBJDump(int, Scheme_Object *[])
{
# if REDIRECT_STDIO || WINDOW_STDIO || WCONSOLE
# if REDIRECT_STDIO || WCONSOLE_STDIO
# define PRINT_IT MrEdSchemeMessages
# else
# define PRINT_IT scheme_console_printf
@ -3202,19 +2824,6 @@ void *wxMallocAtomicIfPossible(size_t s)
return v;
}
static const char *CallSchemeExpand(const char *filename, const char *who, int to_write)
{
char *s;
s = scheme_expand_filename((char *)filename, strlen(filename),
who, 0,
(to_write
? SCHEME_GUARD_FILE_WRITE
: SCHEME_GUARD_FILE_READ));
return s ? s : filename;
}
#if !defined(USE_SENORA_GC) && !defined(MZ_PRECISE_GC)
static void MrEdIgnoreWarnings(char *, GC_word)
{
@ -3233,8 +2842,6 @@ static Scheme_Env *setup_basic_env()
scheme_set_banner(BANNER);
wxmeExpandFilename = CallSchemeExpand;
#ifdef DANGER_ALARM
{
DangerThreadTimer *t = new WXGC_PTRS DangerThreadTimer();
@ -3316,7 +2923,7 @@ wxFrame *MrEdApp::OnInit(void)
new WXGC_PTRS Regex("a", 0);
#endif
#if REDIRECT_STDIO || WINDOW_STDIO || WCONSOLE_STDIO
#if REDIRECT_STDIO || WCONSOLE_STDIO
if (!wx_in_terminal) {
scheme_make_stdin = CAST_MK MrEdMakeStdIn;
scheme_make_stdout = CAST_MK MrEdMakeStdOut;
@ -3337,7 +2944,7 @@ wxFrame *MrEdApp::OnInit(void)
# endif
#endif
#if REDIRECT_STDIO || WINDOW_STDIO || WCONSOLE_STDIO
#if REDIRECT_STDIO || WCONSOLE_STDIO
scheme_console_printf = CAST_PRINTF MrEdSchemeMessages;
if (!wx_in_terminal) {
scheme_console_output = CAST_OUTPUT MrEdSchemeMessagesOutput;
@ -3348,8 +2955,6 @@ wxFrame *MrEdApp::OnInit(void)
mred_event_dispatch_param = scheme_new_param();
mred_ps_setup_param = scheme_new_param();
wxInitSnips(); /* and snip classes */
mred_eventspace_type = scheme_make_type("<eventspace>");
mred_nested_wait_type = scheme_make_type("<eventspace-nested-wait>");
mred_eventspace_hop_type = scheme_make_type("<internal:eventspace-hop>");
@ -3389,16 +2994,6 @@ wxFrame *MrEdApp::OnInit(void)
cl = new WXGC_PTRS wxChildList();
mmc->topLevelWindowList = cl;
}
{
wxStandardSnipClassList *scl;
scl = wxMakeTheSnipClassList();
mmc->snipClassList = scl;
}
{
wxBufferDataClassList *dcl;
dcl = wxMakeTheBufferDataClassList();
mmc->bufferDataClassList = dcl;
}
{
MrEdFinalizedContext *fc;
fc = new WXGC_PTRS MrEdFinalizedContext;
@ -3418,7 +3013,7 @@ wxFrame *MrEdApp::OnInit(void)
TheMrEdApp->wx_frame = mred_real_main_frame;
#endif
wxInitMedia();
wxInitClipboard();
wxscheme_early_gl_init();
@ -3432,41 +3027,9 @@ wxFrame *MrEdApp::OnInit(void)
mred_run_from_cmd_line(argc, argv, setup_basic_env);
#if WINDOW_STDIO
if (!wx_in_terminal) {
/* The only reason we get here is that a command-line error or
-h occured. In either case, stick around for the sake of the
console. */
setup_basic_env();
TheMrEdApp->initialized = 1;
stdio_kills_prog = 1;
if (ioFrame)
ioFrame->CloseIsQuit();
wxTheApp->MainLoop();
}
#endif
return NULL;
}
#if WINDOW_STDIO
static void MrEdExit(int v)
{
if (have_stdio) {
stdio_kills_prog = 1;
if (ioFrame)
ioFrame->CloseIsQuit();
scheme_close_managed(main_custodian);
return;
}
#ifdef wx_msw
mred_clean_up_gdi_objects();
#endif
scheme_immediate_exit(v);
}
#endif
static void on_main_killed(Scheme_Thread *p)
{
on_handler_killed(p);
@ -3488,13 +3051,7 @@ void MrEdApp::RealInit(void)
initialized = 1;
wxMediaIOCheckLSB(/* scheme_console_printf */);
thread->on_kill = CAST_TOK on_main_killed;
#if WINDOW_STDIO
if (!wx_in_terminal)
scheme_exit = CAST_EXIT MrEdExit;
#endif
#ifdef wx_xt
if (wx_single_instance) {
@ -3968,13 +3525,6 @@ void wxDrop_Runtime(char **argv, int argc)
#if defined(wx_mac) || defined(wx_msw)
void wxDrop_Quit()
{
#if WINDOW_STDIO
if (ioFrame) {
if (ioFrame->OnClose())
ioFrame->Show(FALSE);
}
#endif
wxDo(wxs_app_quit_proc, 0, NULL);
}
#endif

17
src/mred/mred.h
View File

@ -52,8 +52,6 @@ typedef struct MrEdContext {
MrEdFinalizedContext *finalized;
wxChildList *topLevelWindowList;
wxStandardSnipClassList *snipClassList;
wxBufferDataClassList *bufferDataClassList;
wxWindow *modal_window;
MrEd_Saved_Modal *modal_stack;
@ -191,19 +189,8 @@ MRED_EXTERN void mred_set_run_from_cmd_line(MrEd_Run_From_Cmd_Line_Proc);
#endif
#define BANNER "MrEd v" MZSCHEME_VERSION mrVERSION_SUFFIX ", Copyright (c) 2004-2009 PLT Scheme Inc.\n"
#ifndef WINDOW_STDIO
/* Removing "|| defined(wx_msw)" below uses the Windows console.
The danger is that closing that console kills MrEd without
any chance of cancelling the kill. */
# if defined(wx_mac) || defined(wx_msw)
# define WINDOW_STDIO 1
# else
# define WINDOW_STDIO 0
# endif
#endif
#ifndef WCONSOLE_STDIO
# if defined(wx_msw) && !WINDOW_STDIO
# if defined(wx_msw)
# define WCONSOLE_STDIO 1
# else
# define WCONSOLE_STDIO 0
@ -211,7 +198,7 @@ MRED_EXTERN void mred_set_run_from_cmd_line(MrEd_Run_From_Cmd_Line_Proc);
#endif
#ifndef REDIRECT_STDIO
# if (defined(wx_msw) || defined(wx_mac)) && !WINDOW_STDIO && !WCONSOLE_STDIO
# if (defined(wx_msw) || defined(wx_mac)) && !WCONSOLE_STDIO
# define REDIRECT_STDIO 1
# else
# define REDIRECT_STDIO 0

5
src/mred/mredmac.cxx
View File

@ -10,7 +10,10 @@
#include "common.h"
#include "wx_main.h"
#include "wx_media.h"
#include "wx_win.h"
#include "wx_frame.h"
#include "wx_canvs.h"
#include "wx_utils.h"
#include "scheme.h"
#include "wx_macevents.h"
#include "wx_het.h"

2
src/mred/mredmsw.cxx
View File

@ -12,7 +12,7 @@
# include "wx.h"
#endif
#include "wx_main.h"
#include "wx_media.h"
#include "wx_utils.h"
#include "scheme.h"
#include "wx_dialg.h"

2
src/mred/mredx.cxx
View File

@ -12,7 +12,7 @@
#define Uses_XLib
#include "wx_main.h"
#include "wx_media.h"
#include "wx_win.h"
#include "wx_clipb.h"
#include "scheme.h"

136
src/mred/wxme/Makefile.in
View File

@ -1,136 +0,0 @@
srcdir = @srcdir@
builddir = @builddir@
PLTSRCDIR = $(srcdir)/../..
PLTBUILDDIR = $(builddir)/../..
###########################
# Common Macros #
###########################
CC = @CC@
CXX = @CXX@
LINKER = $(CXX)
PERL = @PERL@
RANLIB = @RANLIB@
AR = @STATIC_AR@
ARFLAGS = @ARFLAGS@
OPTIONS = @OPTIONS@ @MROPTIONS@
COMPFLAGS = @CFLAGS@ @PROFFLAGS@
XINCLUDE = @X_CFLAGS@
XLIB = @X_LIBS@
LDLIBS = @X_PRE_LIBS@ -lXaw -lXmu -lXt -lX11 -lXext @X_EXTRA_LIBS@ @LIBS@
GCDIRECTORY = @GCDIR@
WBUILD = @WBUILD@
WXVARIANT = @WXVARIANT@
WXINC_wx_xt = -I$(PLTSRCDIR)/wxxt/src/AIAI-include -I$(PLTSRCDIR)/wxxt/src
WXINC_wx_mac = -I$(PLTSRCDIR)/wxmac/include/base -I$(PLTSRCDIR)/wxmac/include/mac -I$(PLTSRCDIR)/wxcommon -I$(PLTSRCDIR)/a-list/c-headers/
WXINC = $(WXINC_@WXVARIANT@)
NOGCINC = $(WXINC) -I$(PLTSRCDIR)/mred/wxme/ -I$(PLTBUILDDIR)/mzscheme/ -I$(PLTSRCDIR)/mzscheme/include/
INC = -I$(PLTSRCDIR)/mzscheme/$(GCDIRECTORY) $(NOGCINC)
CXXFLAGS = $(XINCLUDE) $(INC) $(OPTIONS) -D$(WXVARIANT) @COMPFLAGS@ @PROFFLAGS@ @CXXFLAGS@ @PREFLAGS@
CFLAGS = $(XINCLUDE) $(INC) $(OPTIONS) -D$(WXVARIANT) @COMPFLAGS@ @PROFFLAGS@ @CFLAGS@ @PREFLAGS@
LDFLAGS = $(XLIB)
###########################
OBJECTS = wx_style.@LTO@ wx_keym.@LTO@ wx_mbuf.@LTO@ \
wx_media.@LTO@ wx_mpriv.@LTO@ wx_msnip.@LTO@ \
wx_mline.@LTO@ wx_mpbrd.@LTO@ \
wx_medad.@LTO@ wx_snip.@LTO@ wx_cgrec.@LTO@ \
wx_medio.@LTO@
OBJECTHEADER_wx_xt = $(srcdir)/../../wxxt/src/DataStructures/Object.h
PENBRUSHHEADER_wx_xt = $(srcdir)/../../wxxt/src/GDI-Classes/Pen+Brush.h
DCHEADER_wx_xt = $(srcdir)/../../wxxt/src/DeviceContexts/DC.h
STDEVHEADER_wx_xt = $(srcdir)/../../wxxt/src/EventHandling/wx_stdev.h
WINDOWHEADER_wx_xt = $(srcdir)/../../wxxt/src/Windows/Window.h
OBJECTHEADER_wx_mac = $(srcdir)/../../wxmac/include/base/wx_obj.h
PENBRUSHHEADER_wx_mac =
DCHEADER_wx_mac =
STDEVHEADER_wx_mac =
WINDOWHEADER_wx_mac =
PENBRUSHHEADER = $(PENBRUSHHEADER_@WXVARIANT@)
DCHEADER = $(DCHEADER_@WXVARIANT@)
STDEVHEADER = $(STDEVHEADER_@WXVARIANT@)
WINDOWHEADER = $(WINDOWHEADER_@WXVARIANT@)
WXPRECOMPDIR = ../../wxmac/src
ALLHEADERS = $(srcdir)/wx_ptreq.h $(srcdir)/wx_mtype.h \
$(OBJECTHEADER_@WXVARIANT@) @WXPRECOMP@ \
$(srcdir)/../../wxcommon/wxGC.h $(srcdir)/../../wxcommon/wx_list.h
HEADERS = $(srcdir)/wx_media.h $(srcdir)/wx_medad.h $(srcdir)/wx_cgrec.h \
$(srcdir)/wx_medio.h $(srcdir)/wx_style.h \
$(ALLHEADERS) $(WINDOWHEADER) $(DCHEADER) $(STDEVHEADER)
libwxme.@LIBSFX@: $(OBJECTS)
$(AR) $(ARFLAGS) libwxme.@LIBSFX@ $(OBJECTS)
$(RANLIB) libwxme.@LIBSFX@
LOCALFLAGS_wx_xt = @WX_MMD_FLAG@
LOCALFLAGS_wx_mac = -MMD -DWX_CARBON
LOCALFLAGS = $(LOCALFLAGS_@WXVARIANT@)
MCC = $(CXX) @USE_WXPRECOMP@ $(CXXFLAGS) $(LOCALFLAGS) -c
wx_media.@LTO@ : $(srcdir)/wx_media.cxx $(HEADERS) $(srcdir)/wx_keym.h $(srcdir)/wx_snip.h \
$(srcdir)/wx_mpriv.h $(srcdir)/wx_mline.h
$(MCC) $(srcdir)/wx_media.cxx -o wx_media.@LTO@
wx_mpriv.@LTO@ : $(srcdir)/wx_mpriv.cxx $(HEADERS) $(srcdir)/wx_keym.h $(srcdir)/wx_snip.h $(srcdir)/wx_mpriv.h \
$(srcdir)/wx_mline.h $(srcdir)/wx_gcrct.h $(PENBRUSHHEADER)
$(MCC) $(srcdir)/wx_mpriv.cxx -o wx_mpriv.@LTO@
wx_msnip.@LTO@ : $(srcdir)/wx_msnip.cxx $(HEADERS) $(srcdir)/wx_keym.h $(srcdir)/wx_snip.h $(srcdir)/wx_madm.h \
$(srcdir)/wx_mpriv.h $(srcdir)/wx_gcrct.h
$(MCC) $(srcdir)/wx_msnip.cxx -o wx_msnip.@LTO@
wx_mline.@LTO@ : $(srcdir)/wx_mline.cxx $(srcdir)/wx_mline.h $(srcdir)/wx_snip.h $(HEADERS)
$(MCC) $(srcdir)/wx_mline.cxx -o wx_mline.@LTO@
wx_mpbrd.@LTO@ : $(srcdir)/wx_mpbrd.cxx $(HEADERS) $(srcdir)/wx_keym.h $(srcdir)/wx_snip.h $(srcdir)/wx_medpb.h \
$(PENBRUSHHEADER)
$(MCC) $(srcdir)/wx_mpbrd.cxx -o wx_mpbrd.@LTO@
wx_medad.@LTO@ : $(srcdir)/wx_medad.cxx $(HEADERS) $(srcdir)/wx_snip.h $(srcdir)/wx_madm.h
$(MCC) $(srcdir)/wx_medad.cxx -o wx_medad.@LTO@
wx_mbuf.@LTO@ : $(srcdir)/wx_mbuf.cxx $(HEADERS) $(srcdir)/wx_keym.h $(srcdir)/wx_snip.h $(srcdir)/../../wxcommon/PSDC.h
$(MCC) $(srcdir)/wx_mbuf.cxx -o wx_mbuf.@LTO@
wx_snip.@LTO@ : $(srcdir)/wx_snip.cxx $(HEADERS) $(srcdir)/wx_gcrct.h
$(MCC) $(srcdir)/wx_snip.cxx -o wx_snip.@LTO@
wx_cgrec.@LTO@ : $(srcdir)/wx_cgrec.cxx $(HEADERS) $(srcdir)/wx_snip.h
$(MCC) $(srcdir)/wx_cgrec.cxx -o wx_cgrec.@LTO@
wx_keym.@LTO@ : $(srcdir)/wx_keym.cxx $(srcdir)/wx_keym.h $(ALLHEADERS)
$(MCC) $(srcdir)/wx_keym.cxx -o wx_keym.@LTO@
wx_medio.@LTO@ : $(srcdir)/wx_medio.cxx $(srcdir)/wx_medio.h $(ALLHEADERS)
$(MCC) $(srcdir)/wx_medio.cxx -o wx_medio.@LTO@
wx_style.@LTO@ : $(srcdir)/wx_style.cxx $(srcdir)/wx_style.h $(srcdir)/wx_medio.h $(ALLHEADERS) \
$(DCHEADER) $(PENBRUSHHEADER)
$(MCC) $(srcdir)/wx_style.cxx -o wx_style.@LTO@
clean:
rm -f *.@LTO@ *.@LIBSFX@ *.d *~ core
@INCLUDEDEP@ wx_style.d
@INCLUDEDEP@ wx_keym.d
@INCLUDEDEP@ wx_mbuf.d
@INCLUDEDEP@ wx_media.d
@INCLUDEDEP@ wx_mpriv.d
@INCLUDEDEP@ wx_msnip.d
@INCLUDEDEP@ wx_mline.d
@INCLUDEDEP@ wx_mpbrd.d
@INCLUDEDEP@ wx_medad.d
@INCLUDEDEP@ wx_snip.d
@INCLUDEDEP@ wx_cgrec.d
@INCLUDEDEP@ wx_medio.d

753
src/mred/wxme/wx_cgrec.cxx
View File

@ -1,753 +0,0 @@
/*
* File: wx_cgrec.cc
* Purpose: wxChangeRecord implementations
* Author: Matthew Flatt
* Created: 1995
* Copyright: (c) 2004-2009 PLT Scheme Inc.
* Copyright: (c) 1995, Matthew Flatt
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301 USA.
*/
#if defined(_MSC_VER) && defined(MZ_PRECISE_GC)
# include "wx.h"
#endif
#include "common.h"
#include <stdio.h>
#include <string.h>
#include "wx_media.h"
#include "wx_ptreq.h"
class wxcgList
#ifndef MZ_PRECISE_GC
: public gc
#endif
{
public:
long count, size;
wxObject **array;
wxcgList(void) { count = size = 0; }
int Count() { return count; }
wxObject *Get(int i) { return array[i]; }
void Append(wxObject *o);
void DeleteAll(void);
};
void wxcgList::Append(wxObject *o)
{
if (count >= size) {
wxObject **naya;
if (size)
size *= 2;
else
size = 2;
naya = new WXGC_PTRS wxObject*[size];
memcpy(naya, array, count * sizeof(wxObject*));
array = naya;
}
array[count++] = o;
}
void wxcgList::DeleteAll(void)
{
wxObject *o;
while (count--) {
o = array[count];
DELETE_OBJ o;
}
}
wxChangeRecord::wxChangeRecord(void)
{
}
wxChangeRecord::~wxChangeRecord(void)
{
}
Bool wxChangeRecord::Undo(wxMediaBuffer *)
{
return FALSE;
}
void wxChangeRecord::DropSetUnmodified(void)
{
}
Bool wxChangeRecord::IsComposite()
{
return FALSE;
}
wxChangeRecordId *wxChangeRecord::GetId()
{
return NULL;
}
int wxChangeRecord::GetParity()
{
return 0;
}
wxChangeRecord *wxChangeRecord::Inverse()
{
return NULL;
}
#if CGREC_DEBUG
char *wxChangeRecord::GetName()
{
return "???";
}
#endif
wxSchemeModifyRecord::wxSchemeModifyRecord(void *proc)
{
p = proc;
}
extern int wxsSchemeUndo(void *);
Bool wxSchemeModifyRecord::Undo(wxMediaBuffer *)
{
return wxsSchemeUndo(p);
}
#if CGREC_DEBUG
char *wxSchemeModifyRecord::GetName()
{
return "scheme-modify";
}
#endif
wxUnmodifyRecord::wxUnmodifyRecord(Bool _cont)
{
ok = 1;
cont = _cont;
}
Bool wxUnmodifyRecord::Undo(wxMediaBuffer *media)
{
if (ok)
media->SetModified(FALSE);
return cont;
}
void wxUnmodifyRecord::DropSetUnmodified(void)
{
ok = 0;
}
#if CGREC_DEBUG
char *wxUnmodifyRecord::GetName()
{
return "unmodify";
}
#endif
wxInsertRecord::wxInsertRecord(long position, long length, Bool cont, long ss, long es)
{
start = position;
end = position + length;
continued = cont;
startsel = ss;
endsel = es;
}
Bool wxInsertRecord::Undo(wxMediaBuffer *buffer)
{
wxMediaEdit *media;
media = (wxMediaEdit *)buffer;
media->Delete(start, end);
media->SetPosition(startsel, endsel);
return continued;
}
#if CGREC_DEBUG
char *wxInsertRecord::GetName()
{
return "insert";
}
#endif
wxInsertSnipRecord::wxInsertSnipRecord(wxSnip *thesnip, Bool cont)
{
snip = thesnip;
continued = cont;
}
Bool wxInsertSnipRecord::Undo(wxMediaBuffer *buffer)
{
wxMediaPasteboard *media;
media = (wxMediaPasteboard *)buffer;
media->Delete(snip);
if (!continued)
media->SetSelected(snip);
return continued;
}
#if CGREC_DEBUG
char *wxInsertSnipRecord::GetName()
{
return "insert-snip";
}
#endif
class DeleteSnipItem /* : public wxObject --- uncomment to GC */
{
public:
~DeleteSnipItem();
wxDeleteSnipRecord *parent;
wxSnip *snip, *before;
double x, y;
};
DeleteSnipItem::~DeleteSnipItem()
{
if (!parent->undid) {
if (snip->flags & wxSNIP_OWNED)
snip->flags -= wxSNIP_OWNED;
snip->SetAdmin(NULL);
}
}
wxDeleteSnipRecord::wxDeleteSnipRecord(Bool cont)
{
continued = cont;
deletions = new WXGC_PTRS wxcgList();
}
wxDeleteSnipRecord::~wxDeleteSnipRecord()
{
int i;
for (i = deletions->Count(); i--; ) {
DeleteSnipItem *ds;
ds = (DeleteSnipItem *)deletions->Get(i);
}
DELETE_OBJ deletions;
}
void wxDeleteSnipRecord::InsertSnip(wxSnip *snip, wxSnip *before,
double x, double y)
{
DeleteSnipItem *item;
item = new WXGC_PTRS DeleteSnipItem();
item->parent = this;
item->snip = snip;
item->before = before;
item->x = x;
item->y = y;
deletions->Append((wxObject *)item);
}
Bool wxDeleteSnipRecord::Undo(wxMediaBuffer *buffer)
{
DeleteSnipItem *item;
wxMediaPasteboard *media;
int i, count;
media = (wxMediaPasteboard *)buffer;
if (!continued)
media->NoSelected();
count = deletions->Count();
for (i = 0; i < count; i++) {
item = (DeleteSnipItem *)deletions->Get(i);
/* Have to turn off the owned flag; we know that it's really ours */
if (item->snip->flags & wxSNIP_OWNED)
item->snip->flags -= wxSNIP_OWNED;
media->Insert(item->snip, item->before, item->x, item->y);
if (!continued)
media->AddSelected(item->snip);
}
undid = TRUE;
return continued;
}
#if CGREC_DEBUG
char *wxDeleteSnipRecord::GetName()
{
return "delete-snip";
}
#endif
wxDeleteRecord::wxDeleteRecord(long startpos, long endpos, Bool cont, long ss, long es)
{
continued = cont;
start = startpos;
end = endpos;
startsel = ss;
endsel = es;
undid = FALSE;
deletions = new WXGC_PTRS wxcgList();
clickbacks = NULL;
}
wxDeleteRecord::~wxDeleteRecord()
{
if (!undid) {
wxSnip *snip;
int i;
for (i = deletions->Count(); i--; ) {
snip = (wxSnip *)deletions->Get(i);
if (snip->flags & wxSNIP_OWNED)
snip->flags -= wxSNIP_OWNED;
snip->SetAdmin(NULL);
}
if (clickbacks)
clickbacks->DeleteAll();
}
DELETE_OBJ deletions;
if (clickbacks)
DELETE_OBJ clickbacks;
}
void wxDeleteRecord::InsertSnip(wxSnip *snip)
{
deletions->Append(snip);
}
void wxDeleteRecord::AddClickback(wxClickback *click)
{
if (!clickbacks) {
clickbacks = new WXGC_PTRS wxcgList();
}
clickbacks->Append((wxObject *)click);
}
Bool wxDeleteRecord::Undo(wxMediaBuffer *buffer)
{
wxSnip *snip;
wxMediaEdit *media;
int i, count;
wxList *toAdd;
media = (wxMediaEdit *)buffer;
toAdd = new WXGC_PTRS wxList(wxKEY_NONE, FALSE);
count = deletions->Count();
for (i = count; i--; ) {
snip = (wxSnip *)deletions->Get(i);
/* Have to turn off the owned flag, though we know that it's really ours */
if (snip->flags & wxSNIP_OWNED)
snip->flags -= wxSNIP_OWNED;
toAdd->Append(snip);
}
media->Insert(toAdd, start);
DELETE_OBJ toAdd;
if (clickbacks) {
count = clickbacks->Count();
for (i = 0; i < count; i++) {
wxClickback *cb;
cb = (wxClickback *)clickbacks->Get(i);
media->SetClickback(cb);
}
}
media->SetPosition(startsel, endsel);
undid = TRUE;
return continued;
}
#if CGREC_DEBUG
char *wxDeleteRecord::GetName()
{
return "delete";
}
#endif
class StyleChange /* : public wxObject */
{
public:
long start, end;
wxStyle *style;
};
wxStyleChangeRecord::wxStyleChangeRecord(long startpos, long endpos, Bool cont, long ss, long es, Bool restoreSel)
{
continued = cont;
start = startpos;
end = endpos;
startsel = ss;
endsel = es;
restoreSelection = restoreSel;
changes = new WXGC_PTRS wxcgList();
}
wxStyleChangeRecord::~wxStyleChangeRecord()
{
int i;
for (i = changes->Count(); i--; ) {
StyleChange *sc;
sc = (StyleChange *)changes->Get(i);
}
}
void wxStyleChangeRecord::AddStyleChange(long start, long end, wxStyle *style)
{
StyleChange *change;
change = new WXGC_PTRS StyleChange;
change->start = start;
change->end = end;
change->style = style;
changes->Append((wxObject *)change);
}
Bool wxStyleChangeRecord::Undo(wxMediaBuffer *buffer)
{
StyleChange *change;
long p;
wxMediaEdit *media;
int i, count;
media = (wxMediaEdit *)buffer;
p = start;
count = changes->Count();
for (i = 0; i < count; i++) {
change = (StyleChange *)changes->Get(i);
media->ChangeStyle(change->style, change->start, change->end);
}
if (restoreSelection)
media->SetPosition(startsel, endsel);
return continued;
}
#if CGREC_DEBUG
char *wxStyleChangeRecord::GetName()
{
return "style-change";
}
#endif
class StyleChangeSnip /* : public wxObject */
{
public:
wxSnip *snip;
wxStyle *style;
};
wxStyleChangeSnipRecord::wxStyleChangeSnipRecord(Bool cont)
{
continued = cont;
changes = new WXGC_PTRS wxcgList();
}
wxStyleChangeSnipRecord::~wxStyleChangeSnipRecord()
{
int i;
for (i = changes->Count(); i--; ) {
StyleChange *sc;
sc = (StyleChange *)changes->Get(i);
}
DELETE_OBJ changes;
}
void wxStyleChangeSnipRecord::AddStyleChange(wxSnip *snip, wxStyle *style)
{
StyleChangeSnip *change;
change = new WXGC_PTRS StyleChangeSnip;
change->snip = snip;
change->style = style;
changes->Append((wxObject *)change);
}
Bool wxStyleChangeSnipRecord::Undo(wxMediaBuffer *buffer)
{
StyleChangeSnip *change;
wxMediaPasteboard *media;
int i, count;
media = (wxMediaPasteboard *)buffer;
if (!continued)
media->NoSelected();
count = changes->Count();
for (i = 0; i < count; i++) {
change = (StyleChangeSnip *)changes->Get(i);
media->ChangeStyle(change->style, change->snip);
if (!continued)
media->AddSelected(change->snip);
}
return continued;
}
#if CGREC_DEBUG
char *wxStyleChangeSnipRecord::GetName()
{
return "style-change-snip";
}
#endif
wxMoveSnipRecord::wxMoveSnipRecord(wxSnip *s, double fx, double fy,
Bool d, Bool cont)
{
snip = s;
continued = cont;
x = fx;
y = fy;
delta = d;
}
Bool wxMoveSnipRecord::Undo(wxMediaBuffer *buffer)
{
wxMediaPasteboard *media;
media = (wxMediaPasteboard *)buffer;
if (delta)
media->Move(snip, x, y);
else
media->MoveTo(snip, x, y);
return continued;
}
#if CGREC_DEBUG
char *wxMoveSnipRecord::GetName()
{
return "move-snip";
}
#endif
wxResizeSnipRecord::wxResizeSnipRecord(wxSnip *s, double fx, double fy,
Bool cont)
{
snip = s;
continued = cont;
x = fx;
y = fy;
}
Bool wxResizeSnipRecord::Undo(wxMediaBuffer *buffer)
{
wxMediaPasteboard *media;
media = (wxMediaPasteboard *)buffer;
media->Resize(snip, x, y);
return continued;
}
#if CGREC_DEBUG
char *wxResizeSnipRecord::GetName()
{
return "resize-snip";
}
#endif
wxCompositeRecord::wxCompositeRecord(int _cnt, wxChangeRecordId *_id, int _parity)
{
cnt = _cnt;
seq = new WXGC_PTRS wxChangeRecord*[cnt];
id = _id;
parity = _parity;
if (!id) {
id = new WXGC_PTRS wxChangeRecordId;
}
if (parity)
id->positive = this;
else
id->negative = this;
}
wxCompositeRecord::~wxCompositeRecord()
{
int i = cnt;
wxChangeRecord *cr;
while (i--) {
cr = seq[i];
DELETE_OBJ cr;
}
cnt = 0;
seq = NULL;
if (id) {
if (parity)
id->positive = NULL;
else
id->negative = NULL;
id = NULL;
}
}
Bool wxCompositeRecord::Undo(wxMediaBuffer *media)
{
int i = cnt;
wxChangeRecord *cr;
while (i--) {
cr = seq[i];
cr->Undo(media);
}
return FALSE;
}
void wxCompositeRecord::DropSetUnmodified()
{
int i = cnt;
wxChangeRecord *cr;
while (i--) {
cr = seq[i];
cr->DropSetUnmodified();
}
}
void wxCompositeRecord::AddUndo(int pos, wxChangeRecord *c)
{
seq[pos] = c;
}
Bool wxCompositeRecord::IsComposite()
{
return TRUE;
}
wxChangeRecordId *wxCompositeRecord::GetId()
{
return id;
}
int wxCompositeRecord::GetParity()
{
return parity;
}
wxChangeRecord *wxCompositeRecord::Inverse()
{
return new WXGC_PTRS wxInverseRecord(id, !parity);
}
#if CGREC_DEBUG
char *wxCompositeRecord::GetName()
{
if (cnt == 1) {
wxChangeRecord *cr;
cr = seq[0];
return cr->GetName();
} else
return "composite";
}
#endif
wxInverseRecord::wxInverseRecord(wxChangeRecordId *_id, int _parity)
{
id = _id;
parity = _parity;
}
wxInverseRecord::~wxInverseRecord()
{
/* Avoid double-frees by not doing anything */
}
wxChangeRecord *wxInverseRecord::Get()
{
if (parity)
return id->positive;
else
return id->negative;
}
Bool wxInverseRecord::Undo(wxMediaBuffer *media)
{
wxChangeRecord *c;
c = Get();
return c->Undo(media);
}
void wxInverseRecord::DropSetUnmodified()
{
wxChangeRecord *c;
c = Get();
if (c)
c->DropSetUnmodified();
}
wxChangeRecordId *wxInverseRecord::GetId()
{
return id;
}
int wxInverseRecord::GetParity()
{
return parity;
}
wxChangeRecord *wxInverseRecord::Inverse()
{
wxChangeRecord *c;
c = Get();
return c->Inverse();
}
#if CGREC_DEBUG
char *wxInverseRecord::GetName()
{
wxChangeRecord *c;
c = Get();
if (c)
return c->GetName();
else
return "inverse";
}
#endif

231
src/mred/wxme/wx_cgrec.h
View File

@ -1,231 +0,0 @@
class wxcgList;
#define CGREC_DEBUG 0
class wxChangeRecordId;
class wxChangeRecord
#ifndef MZ_PRECISE_GC
: public gc
#endif
{
public:
wxChangeRecord(void);
virtual ~wxChangeRecord();
virtual Bool Undo(wxMediaBuffer *media);
virtual void DropSetUnmodified(void);
virtual Bool IsComposite();
virtual wxChangeRecordId *GetId();
virtual int GetParity();
virtual wxChangeRecord *Inverse();
#if CGREC_DEBUG
virtual char *GetName();
#endif
};
class wxSchemeModifyRecord : public wxChangeRecord
{
void *p;
public:
wxSchemeModifyRecord(void *p);
Bool Undo(wxMediaBuffer *media);
#if CGREC_DEBUG
char *GetName();
#endif
};
class wxUnmodifyRecord : public wxChangeRecord
{
Bool ok, cont;
public:
wxUnmodifyRecord(Bool cont);
Bool Undo(wxMediaBuffer *media);
void DropSetUnmodified(void);
#if CGREC_DEBUG
char *GetName();
#endif
};
class wxInsertRecord : public wxChangeRecord
{
private:
long start, end;
long startsel, endsel;
Bool continued;
public:
wxInsertRecord(long position, long length, Bool cont, long startsel, long endsel);
Bool Undo(wxMediaBuffer *media);
#if CGREC_DEBUG
char *GetName();
#endif
};
class wxInsertSnipRecord : public wxChangeRecord
{
private:
wxSnip *snip;
Bool continued;
public:
wxInsertSnipRecord(wxSnip *s, Bool cont);
Bool Undo(wxMediaBuffer *media);
#if CGREC_DEBUG
char *GetName();
#endif
};
class wxDeleteRecord : public wxChangeRecord
{
private:
Bool continued;
long start, end;
long startsel, endsel;
wxcgList *deletions;
wxcgList *clickbacks;
Bool undid;
public:
wxDeleteRecord(long start, long end, Bool cont, long startsel, long endsel);
~wxDeleteRecord();
void InsertSnip(wxSnip *);
void AddClickback(wxClickback *);
Bool Undo(wxMediaBuffer *media);
#if CGREC_DEBUG
char *GetName();
#endif
};
class wxDeleteSnipRecord : public wxChangeRecord
{
private:
Bool continued;
wxcgList *deletions;
public:
Bool undid;
wxDeleteSnipRecord(Bool cont);
~wxDeleteSnipRecord();
void InsertSnip(wxSnip *, wxSnip *, double, double);
Bool Undo(wxMediaBuffer *media);
#if CGREC_DEBUG
char *GetName();
#endif
};
class wxStyleChangeRecord : public wxChangeRecord
{
private:
Bool continued, restoreSelection;
long start, end;
long startsel, endsel;
wxcgList *changes;
public:
wxStyleChangeRecord(long start, long end, Bool cont, long startsel, long endsel, Bool restoreSel = 1);
~wxStyleChangeRecord();
void AddStyleChange(long start, long end, wxStyle *style);
Bool Undo(wxMediaBuffer *media);
#if CGREC_DEBUG
char *GetName();
#endif
};
class wxStyleChangeSnipRecord : public wxChangeRecord
{
private:
Bool continued;
wxcgList *changes;
public:
wxStyleChangeSnipRecord(Bool cont);
~wxStyleChangeSnipRecord();
void AddStyleChange(wxSnip *, wxStyle *style);
Bool Undo(wxMediaBuffer *media);
#if CGREC_DEBUG
char *GetName();
#endif
};
class wxMoveSnipRecord : public wxChangeRecord
{
private:
Bool continued;
wxSnip *snip;
double x, y;
Bool delta;
public:
wxMoveSnipRecord(wxSnip *snip, double x, double y, Bool delta, Bool cont);
Bool Undo(wxMediaBuffer *media);
#if CGREC_DEBUG
char *GetName();
#endif
};
class wxResizeSnipRecord : public wxChangeRecord
{
private:
Bool continued;
wxSnip *snip;
double x, y;
public:
wxResizeSnipRecord(wxSnip *snip, double x, double y, Bool cont);
Bool Undo(wxMediaBuffer *media);
#if CGREC_DEBUG
char *GetName();
#endif
};
class wxChangeRecordId {
public:
wxChangeRecord *positive, *negative;
};
class wxCompositeRecord : public wxChangeRecord
{
int cnt;
int parity;
wxChangeRecordId *id;
wxChangeRecord **seq;
public:
wxCompositeRecord(int cnt, wxChangeRecordId *, int parity);
~wxCompositeRecord();
Bool Undo(wxMediaBuffer *media);
void DropSetUnmodified(void);
void AddUndo(int pos, wxChangeRecord *c);
Bool IsComposite();
wxChangeRecordId *GetId();
int GetParity();
wxChangeRecord *Inverse();
#if CGREC_DEBUG
char *GetName();
#endif
};
class wxInverseRecord : public wxChangeRecord
{
int parity;
wxChangeRecordId *id;
wxChangeRecord *Get();
public:
wxInverseRecord(wxChangeRecordId *, int parity);
~wxInverseRecord();
Bool Undo(wxMediaBuffer *media);
void DropSetUnmodified(void);
wxChangeRecordId *GetId();
int GetParity();
wxChangeRecord *Inverse();
#if CGREC_DEBUG
char *GetName();
#endif
};

4
src/mred/wxme/wx_gcrct.h
View File

@ -1,4 +0,0 @@
#define GC_LINE_EXTEND 0
#define GC_RECT_BRUSH_EXTEND 0
#define GC_RECT_FRAME_EXTEND 0

1211
src/mred/wxme/wx_keym.cxx
View File

File diff suppressed because it is too large Load Diff

131
src/mred/wxme/wx_keym.h
View File

@ -1,131 +0,0 @@
#ifndef wx_keym
#define wx_keym
#include "wx_stdev.h"
#include "wx_hash.h"
typedef unsigned int wxchar;
extern int wxstrlen(wxchar *s);
void wxme_utf8_decode(char *str, long len, wxchar **us, long *ulen);
void wxme_utf8_encode(wxchar *us, long ulen, char **s, long *len);
#define UNKNOWN_OBJ void*
typedef Bool (*wxKMFunction)(UNKNOWN_OBJ media, wxEvent *event, void *data);
typedef Bool (*wxGrabKeyFunction)(char *str, class wxKeymap *km,
UNKNOWN_OBJ media, wxKeyEvent *event,
void *data);
typedef Bool (*wxGrabMouseFunction)(char *str, class wxKeymap *km,
UNKNOWN_OBJ media, wxMouseEvent *event,
void *data);
typedef void (*wxBreakSequenceFunction)(void *data);
enum {
wxKEY_FINAL = 0,
wxKEY_PREFIX
};
#define WXK_MOUSE_RIGHT (-1)
#define WXK_MOUSE_LEFT (-2)
#define WXK_MOUSE_MIDDLE (-3)
#define WXK_MOUSE_RIGHT_DOUBLE (-4)
#define WXK_MOUSE_LEFT_DOUBLE (-5)
#define WXK_MOUSE_MIDDLE_DOUBLE (-6)
#define WXK_MOUSE_RIGHT_TRIPLE (-7)
#define WXK_MOUSE_LEFT_TRIPLE (-8)
#define WXK_MOUSE_MIDDLE_TRIPLE (-9)
#define WXK_CLICK_ADDER (-3)
class wxKeymap : public wxObject
{
wxHashTable *functions;
wxHashTable *keys;
int chainCount;
wxKeymap **chainTo;
long doubleInterval;
int lastButton;
int clickCount;
long lastTime;
double lastX, lastY;
class wxKeycode *prefix;
int prefixed;
char *active_mouse_function;
wxGrabKeyFunction grabKeyFunction;
void *grabKeyData;
wxGrabMouseFunction grabMouseFunction;
void *grabMouseData;
wxBreakSequenceFunction onBreak;
void *onBreakData;
class wxKeycode *FindKey(long, long, long, long, long, Bool, Bool, Bool, Bool, Bool, Bool, class wxKeycode *, int *_score);
int HandleEvent(long code, long, long, long, long,
Bool shift, Bool ctrl, Bool alt, Bool meta, Bool cmd, Bool caps,
int score, char **fname, int *fullset);
int GetBestScore(long code, long, long, long, long, Bool shift, Bool ctrl, Bool alt, Bool meta, Bool cmd, Bool caps);
Bool CycleCheck(wxKeymap *km);
int ChainHandleKeyEvent(UNKNOWN_OBJ media, wxKeyEvent *event,
wxGrabKeyFunction grab, void *grabData,
int try_state, int score);
int ChainHandleMouseEvent(UNKNOWN_OBJ media, wxMouseEvent *event,
wxGrabMouseFunction grab, void *grabData,
int try_state, int score);
int OtherHandleKeyEvent(UNKNOWN_OBJ media, wxKeyEvent *event,
wxGrabKeyFunction grab, void *grabData,
int try_state, int score);
int OtherHandleMouseEvent(UNKNOWN_OBJ media, wxMouseEvent *event,
wxGrabMouseFunction grab, void *grabData,
int try_state, int score);
int GetBestScore(wxKeyEvent *event);
int GetBestScore(wxMouseEvent *event);
void Reset(void);
public:
wxKeymap();
~wxKeymap();
virtual Bool HandleKeyEvent(UNKNOWN_OBJ media, wxKeyEvent *event);
virtual Bool HandleMouseEvent(UNKNOWN_OBJ media, wxMouseEvent *event);
void SetGrabKeyFunction(wxGrabKeyFunction grab, void *grabData);
void RemoveGrabKeyFunction(void);
void SetGrabMouseFunction(wxGrabMouseFunction grab, void *grabData);
void RemoveGrabMouseFunction(void);
void BreakSequence(void);
void SetBreakSequenceCallback(wxBreakSequenceFunction f, void *data);
class wxKeycode *MapFunction(long code, int shift, int ctrl,
int alt, int meta, int cmd, int caps, int check_alt,
char *fname, class wxKeycode *prevkey=NULL,
int keytype = wxKEY_FINAL);
void MapFunction(wxchar *keyname, char *fname);
void MapFunction(char *keyname, char *fname);
void AddFunction(char *name, wxKMFunction func, void *data);
Bool CallFunction(char *name, UNKNOWN_OBJ media, wxEvent *event,
Bool try_chained = FALSE);
void ChainToKeymap(wxKeymap *, Bool prefix);
void RemoveChainedKeymap(wxKeymap *);
long GetDoubleClickInterval();
void SetDoubleClickInterval(long);
};
#endif

154
src/mred/wxme/wx_madm.h
View File

@ -1,154 +0,0 @@
/*
* File: wx_madm.cc
* Purpose: wxMediaAdmins
* Author: Matthew Flatt
* Created: 1997
* Copyright: (c) 2004-2009 PLT Scheme Inc.
* Copyright: (c) 1997, Matthew Flatt
*/
#ifndef __WX_MEDIA_ADMIN__
#define __WX_MEDIA_ADMIN__
class wxMediaAdmin : public wxObject
{
private:
friend class wxMediaCanvas;
friend class wxMediaEdit;
friend class wxMediaBuffer;
friend class wxCanvasMediaAdmin;
int standard; /* Used to recognize standard display. Hack. */
public:
inline wxMediaAdmin();
/* Usually called by wxMediaBuffer objects: */
virtual wxDC *GetDC(double *x = NULL, double *y = NULL) = 0;
virtual void GetView(double *x, double *y, double *w, double *h,
Bool full = FALSE) = 0;
virtual Bool ScrollTo(double localx, double localy, double w, double h,
Bool refresh = TRUE, int bias = 0) = 0;
virtual void GrabCaret(int = wxFOCUS_GLOBAL) = 0;
virtual void Resized(Bool redraw_now) = 0;
virtual void NeedsUpdate(double localx, double localy, double w, double h) = 0;
virtual void UpdateCursor() = 0;
virtual void GetMaxView(double *x, double *y, double *w, double *h,
Bool full = FALSE);
virtual Bool DelayRefresh();
virtual Bool PopupMenu(void *m, double x, double y) = 0;
virtual void Modified(Bool) = 0;
};
inline wxMediaAdmin::wxMediaAdmin()
: wxObject(WXGC_NO_CLEANUP)
{
standard = 0;
#if USE_OLD_TYPE_SYSTEM
__type = wxTYPE_MEDIA_ADMIN;
#endif
};
class wxUpdateCursorTimer;
class wxCanvasMediaAdmin : public wxMediaAdmin
{
private:
friend class wxMediaCanvas;
friend class os_wxCanvasMediaAdmin;
friend class wxUpdateCursorTimer;
wxMediaCanvas *canvas;
wxCanvasMediaAdmin *nextadmin, *prevadmin;
Bool resetFlag;
Bool updateBlock, resizedBlock;
wxUpdateCursorTimer *updateCursorTimer;
inline void AdjustStdFlag(void);
wxCanvasMediaAdmin(wxMediaCanvas *c);
public:
~wxCanvasMediaAdmin();
/* Usually called by wxMediaBuffer objects: */
wxDC *GetDC(double *x = NULL, double *y = NULL);
void GetView(double *x, double *y, double *h, double *w, Bool full = FALSE);
Bool ScrollTo(double localx, double localy, double, double,
Bool refresh = TRUE, int bias = 0);
void GrabCaret(int = wxFOCUS_GLOBAL);
void Resized(Bool update);
void NeedsUpdate(double localx, double localy, double w, double h);
void UpdateCursor();
void GetMaxView(double *x, double *y, double *h, double *w, Bool full = FALSE);
Bool PopupMenu(void *m, double x, double y);
inline wxMediaCanvas *GetCanvas() { return canvas; }
void Modified(Bool);
};
/* Used by wxMediaSnipMediaAdmin: */
class wxMSMA_SnipDrawState {
public:
Bool drawing;
double x, y;
wxDC *dc;
};
class wxMediaSnipMediaAdmin : public wxMediaAdmin
{
friend class wxMediaSnip;
friend class os_wxMediaSnipMediaAdmin;
wxMSMA_SnipDrawState *state;
wxMediaSnip *snip;
void RestoreState(wxMSMA_SnipDrawState *saved);
void SaveState(wxMSMA_SnipDrawState *save, wxDC *dc, double x, double y);
wxMediaSnipMediaAdmin(wxMediaSnip *s);
public:
/* Only to make wxs_madm.xc happy */
inline wxMediaSnipMediaAdmin();
~wxMediaSnipMediaAdmin();
wxDC *GetDC(double *x = NULL, double *y = NULL);
void GetView(double *x, double *y, double *h, double *w, Bool full = FALSE);
Bool ScrollTo(double localx, double localy, double w, double h,
Bool refresh = TRUE, int bias = 0);
void GrabCaret(int = wxFOCUS_GLOBAL);
void Resized(Bool redraw_now);
void NeedsUpdate(double localx, double localy, double w, double h);
void UpdateCursor();
virtual Bool DelayRefresh();
Bool PopupMenu(void *m, double x, double y);
inline wxMediaSnip* GetSnip() { return snip; }
void Modified(Bool);
};
/* Only to make wxs_madm.xc happy */
inline wxMediaSnipMediaAdmin::wxMediaSnipMediaAdmin()
{
snip = NULL;
}
#endif /* __WX_MEDIA_ADMIN__ */

2955
src/mred/wxme/wx_mbuf.cxx
View File

File diff suppressed because it is too large Load Diff

1696
src/mred/wxme/wx_medad.cxx
View File

File diff suppressed because it is too large Load Diff

546
src/mred/wxme/wx_medad.h
View File

@ -1,546 +0,0 @@
#ifndef __WX_MEDIA_BUFFER__
#define __WX_MEDIA_BUFFER__
class wxStyleCanvas;
class wxStyleScrollbar;
const long
wxMCANVAS_NO_H_SCROLL = 0x10,
wxMCANVAS_NO_V_SCROLL = 0x2,
wxMCANVAS_HIDE_H_SCROLL = 0x4,
wxMCANVAS_HIDE_V_SCROLL = 0x8,
wxMCANVAS_AUTO_H_SCROLL = 0x01000000,
wxMCANVAS_AUTO_V_SCROLL = 0x02000000;
enum {
wxEDIT_BUFFER =1,
wxPASTEBOARD_BUFFER
};
#define STD_STYLE "Standard"
extern int wxmeCheckFormatAndVersion(wxMediaStreamIn *s, wxMediaStreamInBase *b, Bool showErrors);
extern Bool wxDetectWXMEFile(const char *who, Scheme_Object *f, int peek);
class wxMediaAdmin;
class wxKeymap;
class wxImageSnip;
#ifdef OLD_WXWINDOWS
#ifndef EACH_BUFFER_OWN_OFFSCREEN
#define EACH_BUFFER_OWN_OFFSCREEN
#endif
#endif
#ifndef ALLOW_X_STYLE_SELECTION
#ifdef wx_x
#define ALLOW_X_STYLE_SELECTION 1
#else
#define ALLOW_X_STYLE_SELECTION 0
#endif
#endif
class wxMediaBuffer : public wxObject
{
protected:
#ifdef EACH_BUFFER_OWN_OFFSCREEN
wxBitmap *bitmap;
wxMemoryDC *offscreen;
long bmHeight, bmWidth;
const Bool offscreenInUse = FALSE;
#else
static wxBitmap *bitmap;
static wxMemoryDC *offscreen;
static long bmHeight, bmWidth;
static Bool offscreenInUse;
static wxMediaBuffer *lastUsedOffscreen;
#endif
#if ALLOW_X_STYLE_SELECTION
virtual Bool OwnXSelection(Bool on, Bool update, Bool force) = 0;
Bool DoOwnXSelection(Bool on, Bool force);
void CopyOutXSelection(void);
friend class wxMediaXClipboardClient;
#endif
friend class wxStandardSnipAdmin;
wxMediaAdmin *admin;
wxKeymap *map;
#define TF_Flag(var) unsigned var : 1
TF_Flag( ownCaret );
TF_Flag( tempFilename ); /* TRUE if filename is just a temporary name */
TF_Flag( userLocked );
TF_Flag( modified );
TF_Flag( undomode );
TF_Flag( redomode );
TF_Flag( interceptmode );
TF_Flag( loadoverwritesstyles );
TF_Flag( customCursorOverrides );
TF_Flag( pasteTextOnly );
TF_Flag( needOnDisplaySize );
int num_parts_modified;
int noundomode;
wxSnip *caretSnip;
wxStyleList *styleList;
void *notifyId;
char *filename; /* last loaded file, or NULL */
int maxUndos;
wxChangeRecord **changes;
int changes_start, changes_end, changes_size;
wxChangeRecord **redochanges;
int redochanges_start, redochanges_end, redochanges_size;
wxChangeRecord **savedchanges; /* for Emacs-style undo */
wxList *intercepted;
wxCursor *customCursor;
int inactiveCaretThreshold;
Bool DoWriteHeadersFooters(wxMediaStreamOut *f, Bool headers);
Bool ReadHeadersFooters(wxMediaStreamIn *f, Bool headers);
Bool ReadSnipsFromFile(wxMediaStreamIn *f, int overstyle);
virtual Bool ReadInsert(wxSnip *snip) = 0;
void AddUndo(wxChangeRecord *);
void CopyRingNext(void);
void BeginCopyBuffer(void);
void EndCopyBuffer(void);
void FreeOldCopies(void);
void InstallCopyBuffer(long time, wxStyleList *sl);
void DoBufferPaste(wxClipboard *cb, long time, Bool local = FALSE);
virtual void InsertPasteSnip(wxSnip *snip, wxBufferData *) = 0;
virtual void InsertPasteString(wxchar *str) = 0;
void PerformUndos(Bool redos);
void PerformUndoList(wxList *);
void AppendUndo(wxChangeRecord *, Bool redo);
Bool DoOwnCaret(Bool ownit);
Bool DoSetCaretOwner(wxSnip *, int);
Bool ReadyOffscreen(double w, double h);
virtual void SettingAdmin(wxMediaAdmin *);
virtual void InitNewAdmin(void);
wxStyle *GetDefaultStyle();
public:
wxMediaBuffer();
~wxMediaBuffer();
int bufferType;
wxDC *printing;
void SetAdmin(wxMediaAdmin *admin);
wxMediaAdmin *GetAdmin(void);
virtual void OnEvent(wxMouseEvent *event) = 0;
virtual void OnChar(wxKeyEvent *event) = 0;
virtual wxCursor *AdjustCursor(wxMouseEvent *event) = 0;
virtual void Refresh(double localx, double localy, double w, double h,
Bool show_caret, wxColour *bgColor) = 0;
virtual void OwnCaret(Bool ownit) = 0;
virtual void BlinkCaret() = 0;
virtual void SizeCacheInvalid(void) = 0;
virtual void GetExtent(double *w, double *h) = 0;
virtual void OnDefaultEvent(wxMouseEvent *event) = 0;
virtual void OnLocalEvent(wxMouseEvent *event);
virtual void OnDefaultChar(wxKeyEvent *event) = 0;
virtual void OnLocalChar(wxKeyEvent *event);
/* Callbacks for the wxSnipAdmin: */
virtual wxDC *GetDC();
virtual void GetViewSize(double *h, double *w);
virtual Bool ScrollTo(wxSnip *, double localx, double localy,
double w, double h, Bool refresh, int bias = 0) = 0;
virtual void SetCaretOwner(wxSnip *, int = wxFOCUS_IMMEDIATE) = 0;
virtual void Resized(wxSnip *, Bool redraw_now) = 0;
virtual Bool Recounted(wxSnip *, Bool redraw_now) = 0;
virtual void NeedsUpdate(wxSnip *, double localx, double localy,
double w, double h) = 0;
virtual Bool ReleaseSnip(wxSnip *) = 0;
virtual double ScrollLineLocation(long line) = 0;
virtual long NumScrollLines() = 0;
virtual long FindScrollLine(double y) = 0;
virtual Bool AdminScrollTo(double localx, double localy, double w, double h,
Bool refresh = TRUE, int bias = 0);
virtual wxMediaBuffer *CopySelf(void) = 0;
virtual void CopySelfTo(wxMediaBuffer *b);
virtual double GetDescent(void) = 0;
virtual double GetSpace(void) = 0;
virtual wxchar *GetFlattenedText(long *got = NULL) = 0;
virtual char *GetFlattenedTextUTF8(long *got = NULL);
void GlobalToLocal(double *x, double *y);
void LocalToGlobal(double *x, double *y);
/* Edit & Font menus: */
void DoEdit(int op, Bool recursive = TRUE, long time = 0);
Bool CanEdit(int op, Bool recursive = TRUE);
void DoFont(int op, Bool recursive = TRUE);
virtual void ChangeStyle(wxStyleDelta *) = 0;
virtual Bool ReallyCanEdit(int op) = 0;
virtual void Clear() = 0;
virtual void Cut(Bool extend, long time) = 0;
virtual void Copy(Bool extend, long time) = 0;
virtual void Paste(long time) = 0;
virtual void PasteSelection(long time) = 0;
virtual void Kill(long time) = 0;
virtual void SelectAll(void) = 0;
virtual void Insert(wxSnip *) = 0;
inline wxSnip *GetFocusSnip(void) { return caretSnip; }
void InsertBox(int type = wxEDIT_BUFFER);
void InsertImage(char *filename = NULL, long type = 0,
Bool relative = FALSE, Bool inlineImg = TRUE);
virtual wxSnip *OnNewBox(int type);
void Undo(void);
void Redo(void);
void ClearUndos(void);
void AddSchemeUndo(void *proc);
void SetMaxUndoHistory(int);
int GetMaxUndoHistory();
int AppendEditItems(wxMenu *edit, int idOffset = 0);
int AppendFontItems(wxMenu *font, int idOffset = 0);
virtual Bool GetSnipLocation(wxSnip *thesnip,
double *x = NULL, double *y = NULL,
Bool bottomRight=FALSE) = 0;
virtual Bool WriteToFile(wxMediaStreamOut *) = 0;
virtual Bool ReadFromFile(wxMediaStreamIn *, Bool owrs = FALSE) = 0;
/* Override this to put more information in the file. Make
sure that you follow the rules for extra header data. */
virtual Bool ReadHeaderFromFile(wxMediaStreamIn *, char *headerName);
virtual Bool ReadFooterFromFile(wxMediaStreamIn *, char *headerName);
virtual Bool WriteHeadersToFile(wxMediaStreamOut *);
virtual Bool WriteFootersToFile(wxMediaStreamOut *);
/* Use these functions for adding custom header data: */
Bool BeginWriteHeaderFooterToFile(wxMediaStreamOut *, char *headerName,
long *dataBuffer);
Bool EndWriteHeaderFooterToFile(wxMediaStreamOut *, long dataBuffer);
void SetKeymap(wxKeymap *keymap = NULL);
wxKeymap *GetKeymap(void);
wxStyleList *GetStyleList(void);
virtual void SetStyleList(wxStyleList *styles);
virtual void StyleHasChanged(wxStyle *style) = 0;
/* For making a lot of changes to be displayed at once: */
virtual void BeginEditSequence(Bool undoable = TRUE, Bool interruptSeqs = TRUE) = 0;
virtual void EndEditSequence(void) = 0;
virtual Bool RefreshDelayed(void) = 0;
virtual Bool InEditSequence(void) = 0;
virtual Bool LocationsUpToDate(void) = 0;
virtual wxSnip *FindFirstSnip(void) = 0;
virtual void SetMaxWidth(double w) = 0;
virtual void SetMinWidth(double w) = 0;
virtual double GetMaxWidth() = 0;
virtual double GetMinWidth() = 0;
virtual void SetMinHeight(double w) = 0;
virtual void SetMaxHeight(double w) = 0;
virtual double GetMinHeight() = 0;
virtual double GetMaxHeight() = 0;
virtual void OnPaint(Bool pre, wxDC *dc,
double, double, double, double,
double dx, double dy,
int show_caret);
virtual void InvalidateBitmapCache(double x=0.0, double y=0.0,
double w=-1.0, double h=-1.0) = 0;
void Print(Bool interactive=TRUE, Bool fit=FALSE, int output_mode = 0, wxWindow *parent = NULL,
Bool forcePageBBox = TRUE, Bool asEPS = FALSE);
virtual void *BeginPrint(wxDC *dc, Bool fit) = 0;
virtual void EndPrint(wxDC*, void*) = 0;
virtual void PrintToDC(wxDC *dc, int page = -1) = 0;
virtual Bool HasPrintPage(wxDC *dc, int page) = 0;
virtual Bool SavePort(Scheme_Object *port, int format = wxMEDIA_FF_SAME, Bool showErrors = TRUE) = 0;
virtual int InsertPort(Scheme_Object *port, int format = wxMEDIA_FF_GUESS, Bool replaceStyles = TRUE) = 0;
char *GetFilename(Bool *temp = NULL);
virtual void SetFilename(char *, Bool temp = FALSE) = 0;
virtual wxBufferData *GetSnipData(wxSnip *);
virtual void SetSnipData(wxSnip *, wxBufferData *);
virtual void OnChange(void) = 0;
virtual void OnFocus(Bool on);
virtual Bool CanSaveFile(char *filename, int format);
virtual void OnSaveFile(char *filename, int format);
virtual void AfterSaveFile(Bool success);
virtual Bool CanLoadFile(char *filename, int format);
virtual void OnLoadFile(char *filename, int format);
virtual void AfterLoadFile(Bool success);
virtual void OnEditSequence(void);
virtual void AfterEditSequence(void);
virtual void OnDisplaySize(void);
virtual void OnDisplaySizeWhenReady(void);
virtual wxImageSnip *OnNewImageSnip(char *filename, long type,
Bool relative, Bool inlineImg);
virtual char *GetFile(char *path);
virtual char *PutFile(char *path, char *suggested_name);
wxWindow *ExtractParent(void);
int GetInactiveCaretThreshold(void);
void SetInactiveCaretThreshold(int);
void SetCursor(wxCursor *cursor, Bool override = TRUE);
Bool GetPasteTextOnly(void);
void SetPasteTextOnly(Bool pto);
/* State */
void Lock(Bool);
Bool IsLocked();
Bool Modified(void);
virtual void SetModified(Bool);
virtual void OnSnipModified(wxSnip *, Bool);
void SetLoadOverwritesStyles(Bool);
Bool GetLoadOverwritesStyles();
virtual char *GetDefaultStyleName();
void AddBufferFunctions(wxKeymap *tab);
virtual Bool IsLockedForRead() { return 0; }
virtual Bool IsLockedForFlow() { return 0; }
virtual Bool IsLockedForWrite() { return 0; }
void BeginSequenceLock();
void EndSequenceLock();
void WaitSequenceLock();
#ifdef MEMORY_USE_METHOD
virtual long MemoryUse(void);
#endif
private:
int numExtraHeaders;
void *seq_lock;
};
Bool wxWriteMediaVersion(wxMediaStreamOut *mf, wxMediaStreamOutBase *f);
Bool wxReadMediaVersion(wxMediaStreamIn *f, wxMediaStreamInBase *b, Bool parseFormat, Bool showErrors = TRUE);
Bool wxReadMediaGlobalHeader(wxMediaStreamIn *f);
Bool wxReadMediaGlobalFooter(wxMediaStreamIn *f);
Bool wxWriteMediaGlobalHeader(wxMediaStreamOut *f);
Bool wxWriteMediaGlobalFooter(wxMediaStreamOut *f);
wxStyle *wxmbStyleByIndex(int index);
Bool wxmbWriteSnipsToFile(wxMediaStreamOut *, wxStyleList *,
wxList *, wxSnip *, wxSnip *, wxList *,
wxMediaBuffer *);
class wxCanvasMediaAdmin;
class SimpleScroll;
class wxTimer;
class wxAutoDragTimer;
class wxGLConfig;
class wxMediaCanvas : public wxCanvas
{
friend class wxCanvasMediaAdmin;
friend class wxUpdateCursorTimer;
wxCanvasMediaAdmin *admin;
wxMediaBuffer *media;
wxTimer *blinkTimer;
Bool noloop;
long hpixelsPerScroll;
int givenHScrollsPerPage;
int hscrollsPerPage, vscrollsPerPage;
int scrollHeight, scrollWidth;
char xscroll_on, yscroll_on, auto_x, auto_y;
Bool focuson, focusforcedon;
Bool lazy_refresh, need_refresh;
wxAutoDragTimer *autoDragger;
wxCursor *customCursor;
Bool customCursorOn;
Bool scrollToLast, scrollBottomBased;
int scrollOffset;
int lastwidth, lastheight;
int last_x, last_y;
wxColour *bgColor;
Bool allowXScroll, allowYScroll;
Bool fakeXScroll, fakeYScroll;
SimpleScroll *hscroll, *vscroll;
void PaintScrolls(void);
void GetScroll(int *x, int *y);
Bool ResetVisual(Bool reset_scroll = FALSE);
void GetView(double *fx, double *fy, double *fh, double *fw, Bool full = FALSE);
wxDC *GetDCAndOffset(double *fx, double *fy);
void Redraw(double, double, double, double);
void NoCustomCursor(void);
void UpdateCursorNow(void);
public:
int wheel_amt;
int xmargin, ymargin;
wxMediaCanvas(wxWindow *parent, int x = -1, int y = -1,
int width = -1, int height = -1, char *name = "",
long scrollStyle = 0,
int scrollsPerPage = 100, wxMediaBuffer *m = NULL,
wxGLConfig *gl_cfg = NULL);
~wxMediaCanvas();
Bool IsFocusOn();
Bool ScrollTo(double, double, double, double, Bool refresh = TRUE, int bias = 0);
/* Override some wxCanvas methods: */
virtual void OnSize(int, int);
virtual void OnEvent(wxMouseEvent *event);
virtual void OnChar(wxKeyEvent *event);
virtual void OnPaint(void);
virtual void OnScroll(wxScrollEvent *event);
virtual void OnSetFocus();
virtual void OnKillFocus();
virtual void OnFocus(Bool focus);
virtual void OnScrollOnChange();
virtual void Scroll(int x, int y, Bool refresh);
void ClearMargins();
/* To block bad uses: */
virtual void Scroll(int x, int y);
virtual void SetScrollbars(int h_pixels, int v_pixels, int x_len, int y_len,
int x_page, int y_page, int x_pos=0, int y_pos=0,
Bool setVirtualSize = TRUE);
void BlinkCaret();
void ForceDisplayFocus(Bool on);
void SetLazyRefresh(Bool on);
Bool GetLazyRefresh(void);
void Repaint();
wxMediaBuffer *GetMedia(void);
void SetMedia(wxMediaBuffer *, Bool redisplay = TRUE);
void SetCustomCursor(wxCursor *cursor);
void AllowScrollToLast(Bool toLast);
void ScrollWithBottomBase(Bool bottom);
void *CallAsPrimaryOwner(void *(*f)(void *), void *);
virtual wxMenu *PopupForMedia(wxMediaBuffer *b, void *m);
void ResetSize(void);
void SetXMargin(int);
void SetYMargin(int);
int GetXMargin(void);
int GetYMargin(void);
virtual void SetCanvasBackground(wxColour *);
};
class wxCursor;
#include "wx_madm.h"
class wxStandardSnipAdmin : public wxSnipAdmin
{
wxMediaBuffer *media;
public:
wxStandardSnipAdmin(wxMediaBuffer *m);
wxMediaBuffer *GetMedia(void);
wxDC *GetDC();
void GetViewSize(double *h, double *w);
void GetView(double *x, double *y, double *h, double *w, wxSnip *snip = NULL);
Bool ScrollTo(wxSnip *, double localx, double localy,
double w, double h, Bool refresh, int bias = 0);
void SetCaretOwner(wxSnip *, int = wxFOCUS_IMMEDIATE);
void Resized(wxSnip *, Bool redraw_now);
Bool Recounted(wxSnip *, Bool redraw_now);
void NeedsUpdate(wxSnip *, double localx, double localy,
double w, double h);
Bool ReleaseSnip(wxSnip *);
void UpdateCursor();
Bool PopupMenu(void *m, wxSnip *s, double x, double y);
void Modified(wxSnip *, Bool);
};
class wxBufferData;
class wxStyleList;
extern wxList *wxmb_commonCopyBuffer;
extern wxList *wxmb_commonCopyBuffer2;
extern wxBufferData *wxmb_commonCopyRegionData;
extern wxStyleList *wxmb_copyStyleList;
void wxGetMediaPrintMargin(long *hm=NULL, long *vm=NULL);
void wxSetMediaPrintMargin(long hm=-1, long vm=-1);
void wxAddMediaBufferFunctions(wxKeymap *tab);
#if ALLOW_X_STYLE_SELECTION
extern Bool wxMediaXSelectionMode;
extern wxMediaBuffer *wxMediaXSelectionOwner;
extern wxMediaBuffer *wxMediaXSelectionAllowed;
#endif
void wxMediaSetXSelectionMode(Bool on);
#endif /* __WX_MEDIA_BUFFER__ */

4570
src/mred/wxme/wx_media.cxx
View File

File diff suppressed because it is too large Load Diff

687
src/mred/wxme/wx_media.h
View File

@ -1,687 +0,0 @@
/* Main header file for wxMedia */
/* Include this file for anything using wxMedia */
#ifndef __WX_MEDIA__
#define __WX_MEDIA__
#include "scheme.h"
#include "wx_panel.h"
#include "wx_canvs.h"
#include "wx_dcmem.h"
#include "wx_keym.h"
#include "wx_medio.h"
#include "wx_style.h"
#include "wx_mtype.h"
class wxMediaEdit;
class wxClickback;
class wxClipboard;
extern wxchar wx_empty_wxstr[1];
#define wxFOCUS_IMMEDIATE 0
#define wxFOCUS_DISPLAY 1
#define wxFOCUS_GLOBAL 2
/* File formats */
enum {
wxMEDIA_FF_GUESS,
wxMEDIA_FF_STD,
wxMEDIA_FF_TEXT,
wxMEDIA_FF_TEXT_FORCE_CR,
wxMEDIA_FF_SAME,
wxMEDIA_FF_COPY
};
#include "wx_snip.h"
#include "wx_cgrec.h"
#include "wx_medad.h"
class wxSnipLocation;
class wxMediaFlashTimer;
class wxBitmap;
/* Edit commands */
enum {
wxEDIT_UNDO = 1,
wxEDIT_REDO,
wxEDIT_CLEAR,
wxEDIT_CUT,
wxEDIT_COPY,
wxEDIT_PASTE,
wxEDIT_KILL,
wxEDIT_INSERT_TEXT_BOX,
wxEDIT_INSERT_GRAPHIC_BOX,
wxEDIT_INSERT_IMAGE,
wxEDIT_SELECT_ALL,
_wx_EDIT_counter
};
/* Movement kinds */
enum {
wxMOVE_SIMPLE = 1,
wxMOVE_LINE,
wxMOVE_PAGE,
wxMOVE_WORD
};
/* For Finding Wordbreaks: */
enum {
wxBREAK_FOR_CARET = 1,
wxBREAK_FOR_LINE = 2,
wxBREAK_FOR_SELECTION = 4,
wxBREAK_FOR_USER_1 = 32,
wxBREAK_FOR_USER_2 = 64
};
/* Selection: */
enum {
wxDEFAULT_SELECT = 0,
wxX_SELECT = 1,
wxLOCAL_SELECT = 2
};
/* Drawing: */
enum {
wxSNIP_DRAW_NO_CARET = 0,
wxSNIP_DRAW_SHOW_INACTIVE_CARET,
wxSNIP_DRAW_SHOW_CARET
};
/* For FindSnip: */
#define wxSNIP_BEFORE_OR_NULL (-2)
#define wxSNIP_BEFORE (-1)
#define wxSNIP_AFTER 1
#define wxSNIP_AFTER_OR_NULL 2
#define wxTAB_WIDTH 20
typedef void (*wxClickbackFunc)(wxMediaEdit *, long start, long end, void *);
typedef void (*wxWordbreakFunc)(wxMediaEdit *, long *start, long *end, int reason, void *);
class wxMediaAdmin;
class wxMediaWordbreakMap : public wxObject
{
int usage;
public:
char map[256];
wxMediaWordbreakMap();
void SetMap(int ch, int mask);
int GetMap(int ch);
};
extern wxMediaWordbreakMap *wxTheMediaWordbreakMap;
class wxMediaLine;
class wxMediaEdit : public wxMediaBuffer
{
friend class wxMediaLine;
friend class wxMediaSnipMediaAdmin;
public:
wxMediaEdit(double lineSpacing = 1.0,
double *tabstops = NULL, int numtabs = 0);
~wxMediaEdit();
wxMediaBuffer *CopySelf(void);
void CopySelfTo(wxMediaBuffer *b);
/* Usually called by wxMediaAdmin */
virtual void OnEvent(wxMouseEvent *event);
virtual void OnChar(wxKeyEvent *event);
virtual wxCursor *AdjustCursor(wxMouseEvent *event);
virtual void Refresh(double localx, double localy, double w, double h,
int show_caret, wxColor *bgColor);
virtual void OwnCaret(Bool ownit);
virtual void BlinkCaret();
virtual void SizeCacheInvalid(void);
virtual void OnDefaultEvent(wxMouseEvent *event);
virtual void OnDefaultChar(wxKeyEvent *event);
/* Callbacks for the wxSnipAdmin: */
virtual Bool ScrollTo(wxSnip *, double localx, double localy,
double w, double h, Bool refresh, int bias = 0);
virtual void Resized(wxSnip *, Bool redraw_now);
virtual Bool Recounted(wxSnip *, Bool redraw_now);
virtual void NeedsUpdate(wxSnip *, double localx, double localy,
double w, double h);
virtual void SetCaretOwner(wxSnip *, int = wxFOCUS_IMMEDIATE);
virtual Bool ReleaseSnip(wxSnip *);
/* Methods for you to override: */
virtual void OnChange(void);
virtual Bool CanInsert(long start, long len);
virtual void OnInsert(long start, long len);
virtual void AfterInsert(long start, long len);
virtual Bool CanDelete(long start, long len);
virtual void OnDelete(long start, long len);
virtual void AfterDelete(long start, long len);
virtual Bool CanChangeStyle(long start, long len);
virtual void OnChangeStyle(long start, long len);
virtual void AfterChangeStyle(long start, long len);
virtual void AfterSetPosition(void);
virtual Bool CanSetSizeConstraint(void);
virtual void OnSetSizeConstraint(void);
virtual void AfterSetSizeConstraint(void);
virtual void OnSplitSnip(long pos);
virtual void OnMergeSnips(long pos);
/* Set the caret position: */
void GetPosition(long *start, long *end = NULL);
long GetStartPosition(void);
long GetEndPosition(void);
void SetPosition(long start, long end = -1,
Bool eol = FALSE, Bool scroll = TRUE,
int seltype = wxDEFAULT_SELECT);
void MovePosition(long code, Bool extend = FALSE,
int kind = wxMOVE_SIMPLE);
void SetPositionBiasScroll(int bias, long start, long end = -1,
Bool eol = FALSE, Bool scroll = TRUE,
int seltype = wxDEFAULT_SELECT);
virtual void SetAnchor(Bool);
Bool GetAnchor(void);
Bool ScrollToPosition(long start, Bool ateol = FALSE,
long end = -1, int bias = 0);
void GetVisiblePositionRange(long *start, long *end, Bool all = TRUE);
void GetVisibleLineRange(long *start, long *end, Bool all = TRUE);
/* Hilite a region without changing the selection position: */
void FlashOn(long start, long end, Bool ateol = FALSE,
Bool scroll = TRUE, long timeout = 500);
void FlashOff();
/* Change the text */
void Insert(char *str, long start, long end = -1, Bool scrollOk = TRUE);
void Insert(char *str);
void Insert(long len, char *str, long start, long end = -1, Bool scrollOk=TRUE);
void Insert(long len, char *str);
void Insert(wxchar *str, long start, long end = -1, Bool scrollOk = TRUE);
void Insert(wxchar *str);
void Insert(long len, wxchar *str, long start, long end = -1, Bool scrollOk=TRUE);
void Insert(long len, wxchar *str);
void Insert(wxSnip *snip, long start, long end = -1, Bool scrollOk=TRUE);
void Insert(wxSnip *snip);
void Insert(wxList *snips);
void Insert(wxList *snips, long start, long end = -1);
void Insert(wxchar code_point);
void Insert(wxchar code_point, long start, long end = -1);
void Delete(long start, long end = -1, Bool scrollOk = TRUE);
void Delete();
void Erase();
void Cut(Bool extend, long time, long start, long end = -1);
void Cut(Bool extend = FALSE, long time = 0);
void Copy(Bool extend, long time, long start, long end = -1);
void Copy(Bool extend = FALSE, long time = 0);
void Paste(long time, long start, long end = -1);
void Paste(long time = 0);
void PasteSelection(long time, long start, long end = -1);
void PasteSelection(long time = 0);
void PasteNext(void);
void Kill(long time = 0);
void Kill(long time, long start, long end);
void Clear(void);
void SelectAll(void);
virtual void DoCopy(long start, long end, long time, Bool extend);
virtual void DoPaste(long start, long time);
virtual void DoPasteSelection(long start, long time);
void DoGenericPaste(wxClipboard *cb, long start, long time);
void GenericPaste(Bool x_sel, long time, long start, long end);
/* For making a lot of changes to be displayed at once: */
void BeginEditSequence(Bool undoable = TRUE, Bool interruptSeqs = TRUE);
void EndEditSequence(void);
Bool RefreshDelayed(void);
Bool InEditSequence(void);
Bool LocationsUpToDate(void);
void ChangeStyle(wxStyleDelta *);
void ChangeStyle(wxStyle *, long start = -1, long end = -1, Bool counts_as_mod = TRUE);
void ChangeStyle(wxStyleDelta *, long start, long end = -1, Bool counts_as_mod = TRUE);
/* Called automatically when a style is changed; no need to call this */
void StyleHasChanged(wxStyle *style);
void SetStyleList(wxStyleList *styles);
Bool ReallyCanEdit(int op);
/* Convert canvas co-ordinates to caret position */
long FindPosition(double x, double y, Bool
*ateol = NULL, Bool *onit = NULL,
double *how_close = NULL);
long FindLine(double y, Bool *onit = NULL);
long FindPositionInLine(long i, double x,
Bool *ateol = NULL, Bool *onit =NULL,
double *how_close = NULL);
/* Find the line or canvas co-ordinates for a caret position */
long PositionLine(long start, Bool eol=FALSE);
void PositionLocation(long start,
double *x = NULL, double *y = NULL,
Bool front = TRUE, Bool eol = FALSE,
Bool wholeLine = FALSE);
void PositionLocations(long start,
double *tx, double *ty,
double *bx, double *by,
Bool eol = FALSE, Bool wholeLine = FALSE);
double LineLocation(long line, Bool top = TRUE);
/* Get first/last caret position in a line: */
long LineStartPosition(long i, Bool visibleOnly = TRUE);
long LineEndPosition(long i, Bool visibleOnly = TRUE);
long LineLength(long i);
/* Paragraphs */
long PositionParagraph(long start, Bool eol=FALSE);
long ParagraphStartPosition(long i, Bool visibleOnly = TRUE);
long ParagraphEndPosition(long i, Bool visibleOnly = TRUE);
long LineParagraph(long line);
long ParagraphStartLine(long i);
long ParagraphEndLine(long i);
long LastPosition(void);
long LastLine(void);
long LastParagraph(void);
void SetParagraghMargins(long i, double firstLeft, double left, double right);
void SetParagraghAlignment(long i, int align);
void GetExtent(double *w, double *h);
double GetDescent(void);
double GetSpace(void);
double GetTopLineBase(void);
double ScrollLineLocation(long line);
long NumScrollLines();
long FindScrollLine(double y);
/* Searching */
long FindString(wxchar *str, int direction = 1, long start =-1, long end =-1,
Bool bos = TRUE, Bool caseSens = TRUE);
long *FindStringAll(wxchar *str, long *cnt, int direction = 1,
long start =-1, long end =-1, Bool bos = TRUE,
Bool caseSens = TRUE);
long FindStringUTF8(char *str, int direction = 1, long start =-1, long end =-1,
Bool bos = TRUE, Bool caseSens = TRUE);
long *FindStringAllUTF8(char *str, long *cnt, int direction = 1,
long start =-1, long end =-1, Bool bos = TRUE,
Bool caseSens = TRUE);
long FindNewline(int direction = 1, long start =-1, long end =-1);
/* Create clickable ranges: */
void SetClickback(long start, long end, wxClickbackFunc, void *,
wxStyleDelta *hiliteDelta = NULL, Bool callOnDown = FALSE);
void RemoveClickback(long start, long end);
void CallClickback(long start, long end);
void SetClickback(wxClickback *); /* Used by undo record only */
wxSnip *FindFirstSnip(void);
wxSnip *FindNextNonTextSnip(wxSnip *snip);
wxSnip *FindSnip(long p, int direction, long *sPos = NULL);
Bool GetSnipPositionAndLocation(wxSnip *thesnip, long *pos,
double *x = NULL, double *y = NULL);
Bool GetSnipLocation(wxSnip *thesnip, double *x = NULL, double *y = NULL,
Bool bottomRight=FALSE);
long GetSnipPosition(wxSnip *thesnip);
wxchar *GetFlattenedText(long *len = NULL);
wxchar *GetText(long start = -1, long end = -1,
Bool flattened = FALSE, Bool forceCR = FALSE,
long *got = NULL);
char *GetTextUTF8(long start = -1, long end = -1,
Bool flattened = FALSE, Bool forceCR = FALSE,
long *got = NULL);
wxchar GetCharacter(long start);
char GetTruncatedCharacter(long start);
Bool SavePort(Scheme_Object *port, int format = wxMEDIA_FF_SAME, Bool showErrors = TRUE);
int InsertPort(Scheme_Object *port, int format = wxMEDIA_FF_GUESS, Bool replaceStyles = TRUE);
Bool ReadFromFile(wxMediaStreamIn *, long start, Bool overwritestyle = FALSE);
Bool ReadFromFile(wxMediaStreamIn *, Bool overwritestyle = FALSE);
Bool WriteToFile(wxMediaStreamOut *, long start, long end = -1);
Bool WriteToFile(wxMediaStreamOut *);
void SetFilename(char *, Bool temp = FALSE);
int GetFileFormat(void);
void SetFileFormat(int);
void SplitSnip(long pos);
double *GetTabs(int *length = NULL,
double *tabInc = NULL, Bool *inUnits = NULL);
void SetTabs(double *tabs, int count,
double tabIncrement = wxTAB_WIDTH, Bool inUnits = TRUE);
void AddEditorFunctions(wxKeymap *keymap);
void SetWordbreakFunc(wxWordbreakFunc f, void *data);
void FindWordbreak(long *start, long *end, int reason);
wxMediaWordbreakMap *GetWordbreakMap(void);
void SetWordbreakMap(wxMediaWordbreakMap *map);
virtual void PrintToDC(wxDC *dc, int page = -1);
virtual void *BeginPrint(wxDC *, Bool);
virtual void EndPrint(wxDC *, void *);
virtual Bool HasPrintPage(wxDC *dc, int page);
void SetMaxWidth(double w);
void SetMinWidth(double w);
double GetMaxWidth();
double GetMinWidth();
void SetMinHeight(double h);
void SetMaxHeight(double w);
double GetMinHeight();
double GetMaxHeight();
virtual void InvalidateBitmapCache(double x=0.0, double y=0.0,
double w=-1.0, double h=-1.0);
/* You might need to call this if you're doing text changes within
BeginEditSequence() and EndEditSequence(). Hopefully, it will
get called automatically. */
void Recalculate(void);
void SettingAdmin(wxMediaAdmin *);
void InitNewAdmin(void);
virtual wxBufferData *GetRegionData(long start, long end);
virtual void SetRegionData(long start, long end, wxBufferData *);
void PasteRegionData(wxBufferData *);
virtual wxTextSnip *OnNewTextSnip();
virtual wxTabSnip *OnNewTabSnip();
wxBitmap *SetAutowrapBitmap(wxBitmap *bm);
virtual void OnReflow(void);
void HideCaret(Bool hide);
Bool CaretHidden(void);
double GetBetweenThreshold();
void SetBetweenThreshold(double thresh);
inline Bool GetOverwriteMode(void) { return overwriteMode; }
inline void SetOverwriteMode(Bool m) { overwriteMode = !!m; }
inline double GetLineSpacing() { return lineSpacing; }
void SetLineSpacing(double);
inline Bool GetStickyStyles() { return stickyStyles; }
inline void SetStickyStyles(Bool s) { stickyStyles = s; if (s) caretStyle = NULL; }
#if ALLOW_X_STYLE_SELECTION
virtual Bool OwnXSelection(Bool on, Bool update, Bool force);
#endif
#ifdef MEMORY_USE_METHOD
virtual long MemoryUse(void);
#endif
Bool IsLockedForRead();
Bool IsLockedForFlow();
Bool IsLockedForWrite();
double GetRevisionNumber();
private:
#define TF_Flag(var) unsigned var : 1
TF_Flag( readLocked );
TF_Flag( flowLocked );
TF_Flag( writeLocked );
TF_Flag( hiliteOn );
TF_Flag( changed ); /* Set if OnChange() needs to be called */
TF_Flag( flash );
TF_Flag( flashautoreset );
TF_Flag( flashdirectoff );
TF_Flag( posateol ); /* display the caret at the end of a line? */
TF_Flag( flashposateol );
TF_Flag( flashscroll ); /* Scroll back after unflashing? */
TF_Flag( graphicsInvalid );
TF_Flag( flowInvalid );
TF_Flag( snipCacheInvalid );
TF_Flag( graphicMaybeInvalid );
TF_Flag( graphicMaybeInvalidForce );
TF_Flag( typingStreak );
TF_Flag( deletionStreak );
TF_Flag( delayedStreak );
TF_Flag( vcursorStreak );
TF_Flag( killStreak );
TF_Flag( anchorStreak );
TF_Flag( extendStreak );
TF_Flag( insertForceStreak );
TF_Flag( deleteForceStreak );
TF_Flag( keepAnchorStreak );
TF_Flag( streaksPushed );
TF_Flag( saveTypingStreak );
TF_Flag( saveDeletionStreak );
TF_Flag( saveDelayedStreak );
TF_Flag( saveVcursorStreak );
TF_Flag( saveKillStreak );
TF_Flag( saveAnchorStreak );
TF_Flag( saveExtendStreak );
TF_Flag( dragging );
TF_Flag( tracking );
TF_Flag( extraLine ); /* Empty line at end of file with no representative */
TF_Flag( delayedscrollateol );
TF_Flag( delayedscrollbox );
TF_Flag( drawCachedInBitmap );
TF_Flag( refreshUnset );
TF_Flag( refreshBoxUnset );
TF_Flag( refreshAll );
TF_Flag( tabSpaceInUnits );
TF_Flag( overwriteMode );
TF_Flag( stickyStyles );
#if ALLOW_X_STYLE_SELECTION
TF_Flag( needXCopy );
#endif
TF_Flag( caretBlinked ); /* Whether we want to hide an active caret or not */
TF_Flag( initialStyleNeeded );
#undef TF_Flag
int lastDrawCaret;
int lastDrawXSel;
double lineSpacing;
double maxWidth, minWidth, minHeight, maxHeight;
double wrapBitmapWidth;
wxBitmap *autoWrapBitmap;
int delayRefresh;
long len; /* Total length in "characters" == number of positions - 1 */
long startpos, endpos;
long extendstartpos, extendendpos; /* for extendstreak */
double vcursorloc; /* for vcursorStreak */
wxMediaFlashTimer *flashTimer;
long flashstartpos, flashendpos;
wxSnip *snips, *lastSnip; /* The contents of this edit session */
long snipCount;
wxStandardSnipAdmin *snipAdmin;
wxMediaLine *lineRoot, *firstLine, *lastLine; /* Line information */
long numValidLines;
double extraLineH;
double totalHeight, totalWidth; /* Total height/width in canvas units */
double finalDescent; /* Descent of last line */
double initialSpace; /* Space from first line */
double initialLineBase; /* Inverse descent from first line */
wxStyle *caretStyle;
long dragstart;
wxClickback *trackClickback;
long refreshStart, refreshEnd;
double refreshL, refreshT, refreshR, refreshB;
double lastDrawL, lastDrawT, lastDrawR, lastDrawB;
unsigned char lastDrawRed, lastDrawGreen, lastDrawBlue;
long delayedscroll, delayedscrollend;
int delayedscrollbias;
wxSnip *delayedscrollsnip;
double delayedscrollX, delayedscrollY, delayedscrollW, delayedscrollH;
wxList *clickbacks;
int fileFormat;
double betweenThreshold;
double *tabs;
int tabcount;
double tabSpace;
long readInsert, readInsertStart;
long prevPasteStart, prevPasteEnd;
long savePrevPasteStart, savePrevPasteEnd;
double revision_count;
wxWordbreakFunc wordBreak;
void *wordBreakData;
wxMediaWordbreakMap *wordBreakMap;
void _Insert(wxSnip *snip, long len, wxchar *str, wxList *snips,
long start, long end = -1,
Bool scrollOk = TRUE);
void _Delete(long start, long end, Bool undo, Bool scrollOk);
void _SetPosition(Bool setflash, int bias, long start, long end,
Bool ateol, Bool scroll, int seltype);
void _ChangeStyle(long start, long end, wxStyle *, wxStyleDelta *, Bool restoreSel = 1, Bool counts_as_mod = TRUE);
void MakeOnlySnip(void);
void SpliceSnip(wxSnip *snip, wxSnip *prev, wxSnip *next);
void InsertSnip(wxSnip *before, wxSnip *snip);
void AppendSnip(wxSnip *snip);
void DeleteSnip(wxSnip *snip);
wxSnip *SnipSetAdmin(wxSnip *snip, wxSnipAdmin *a);
void SnipSplit(wxSnip *snip, long pos, wxSnip **a, wxSnip **b);
void MakeSnipset(long start, long end);
wxTextSnip *InsertTextSnip(long start, wxStyle *style = NULL);
void CheckMergeSnips(long start);
void AdjustClickbacks(long start, long end, long d, wxDeleteRecord *rec);
wxClickback *FindClickback(long start, double y);
void SetClickbackHilited(wxClickback *, Bool);
Bool ScrollToPosition(long start, Bool ateol, Bool refresh, long end,
int bias);
long FindFirstVisiblePosition(wxMediaLine *line, wxSnip *snip = NULL);
void FindLastVisiblePosition(wxMediaLine *line, long *p,
wxSnip **snipP = NULL);
long _FindPositionLine(long pos);
void _CalcValidPositionLine(void);
long _FindPositionInLine(Bool internal, long i, double x,
Bool *ateol = NULL, Bool *onit =NULL,
double *how_close = NULL);
long _FindPositionInSnip(wxDC *dc, double X, double Y,
wxSnip *snip, double x, double *how_close = NULL);
void LinesInvalidAfter(long);
void OneLineInvalid(long);
void SnipChangedAt(long);
long _FindStringAll(wxchar *str, int direction,
long start, long end, long **positions,
Bool, Bool, Bool);
Bool InsertFile(const char *who, Scheme_Object *f, char *filename, int *format, Bool clearStyles, Bool showErrors);
void RecalcLines(wxDC *dc, Bool calcGraphic = TRUE);
Bool CheckFlow(double maxw, wxDC *dc, double Y, long startp, wxSnip *start);
Bool CheckRecalc(Bool need_graphic = TRUE, Bool need_write = TRUE, Bool no_display_ok = FALSE);
void Redraw(wxDC *, double, double, double, double, double, double, int, int, wxColour*);
void Redraw();
void NeedRefresh(long start, long end = -1);
void NeedRefresh(double, double, double, double);
void RefreshByLineDemand(void);
void ContinueRefresh(void);
void RefreshBox(double x, double y, double w, double h);
void NeedCaretRefresh(void);
void EndStreaks(int exception = 0);
void PushStreaks(void);
void PopStreaks(void);
public:
Bool ReadInsert(wxList *snipl);
protected:
Bool ReadInsert(wxSnip *snip);
void InsertPasteSnip(wxSnip *snip, wxBufferData *);
void InsertPasteString(wxchar *str);
};
#include "wx_medpb.h"
void wxInitMedia(void);
void wxAddMediaEditorFunctions(wxKeymap *tab);
void wxAddMediaPasteboardFunctions(wxKeymap *tab);
extern const char *(*wxmeExpandFilename)(const char *, const char *, int);
extern void wxmeError(const char *e);
extern wxMediaSnip *wxsMakeMediaSnip(wxMediaBuffer *useme,
Bool border,
int lm, int tm, int rm, int bm,
int li, int ti, int ri, int bi,
double w, double W, double h, double H);
extern wxMediaEdit *wxsMakeMediaEdit();
extern wxMediaPasteboard *wxsMakeMediaPasteboard();
extern int wxGetPreference(const char *name, int *res);
extern int wxGetBoolPreference(const char *name, int *res);
#endif /* __WX_MEDIA__ */

1532
src/mred/wxme/wx_medio.cxx
View File

File diff suppressed because it is too large Load Diff

262
src/mred/wxme/wx_medio.h
View File

@ -1,262 +0,0 @@
/* Header file for wxMediaStream */
#ifndef wx_medio
#define wx_medio
#include "scheme.h"
class wxMediaStreamInBase : public wxObject
{
public:
virtual long Tell(void) = 0;
virtual void Seek(long) = 0;
virtual void Skip(long) = 0;
virtual Bool Bad(void) = 0;
virtual long Read(char *data, long len, long delta = 0) = 0;
};
class wxMediaStreamOutBase : public wxObject
{
public:
virtual long Tell(void) = 0;
virtual void Seek(long) = 0;
virtual Bool Bad(void) = 0;
virtual void Write(char *data, long len) = 0;
void Write(char *data, long len, int delta);
};
/*******************************************************************/
class wxMediaStreamInFileBase : public wxMediaStreamInBase
{
Scheme_Object *f;
public:
wxMediaStreamInFileBase(Scheme_Object *s);
~wxMediaStreamInFileBase();
long Tell(void);
void Seek(long);
void Skip(long);
Bool Bad(void);
long Read(char *data, long len, long delta = 0);
};
class wxMediaStreamOutFileBase : public wxMediaStreamOutBase
{
Scheme_Object *f;
public:
wxMediaStreamOutFileBase(Scheme_Object *s);
~wxMediaStreamOutFileBase();
long Tell(void);
void Seek(long);
Bool Bad(void);
void Write(char *data, long len);
void Write(char *data, long len, int delta);
};
/*******************************************************************/
class wxMediaStreamInStringBase : public wxMediaStreamInBase
{
char *a_string;
long len;
long pos;
Bool bad;
public:
wxMediaStreamInStringBase(char *s, long len);
~wxMediaStreamInStringBase();
long Tell(void);
void Seek(long);
void Skip(long);
Bool Bad(void);
long Read(char *data, long len, long delta = 0);
};
class wxMediaStreamOutStringBase : public wxMediaStreamOutBase
{
char *a_string;
long len, alloc;
long pos;
Bool bad;
public:
wxMediaStreamOutStringBase();
~wxMediaStreamOutStringBase();
char *GetString(long *len);
long Tell(void);
void Seek(long);
Bool Bad(void);
void Write(char *data, long len);
void Write(char *data, long len, int delta);
};
/*******************************************************************/
#define MRED_READER_STR "#reader(lib\"read.ss\"\"wxme\")"
#define MRED_READER_STR_LEN 27
#define MRED_START_STR_LEN 4
#define MRED_START_STR "WXME"
#define MRED_START_STR_LEN 4
#define MRED_FORMAT_STR "01"
#define MRED_FORMAT_STR_LEN 2
#define MRED_VERSION_STR "08"
#define MRED_VERSION_STR_LEN 2
#define MZSCHEME_WRITER_VERSION "370"
#define WXME_VERSION_ONE(f) (f->read_version[1] == '1')
#define WXME_VERSION_TWO(f) (f->read_version[1] == '2')
#define WXME_VERSION_THREE(f) (f->read_version[1] == '3')
#define WXME_VERSION_FOUR(f) (f->read_version[1] == '4')
#define WXME_VERSION_FIVE(f) (f->read_version[1] == '5')
#define WXME_VERSION_SIX(f) (f->read_version[1] == '6')
#define WXME_VERSION_SEVEN(f) (f->read_version[1] == '7')
#define WXME_VERSION_BEFORE_EIGHT(f) ((f->read_version[1] >= '1') && (f->read_version[1] <= '7'))
class wxStandardSnipClassList;
class wxBufferDataClassList;
class wxSnipClass;
class wxBufferDataClass;
class wxStyleList;
class wxStyle;
class wxSnipClassLink
{
public:
wxSnipClass *c;
char *name;
Bool headerFlag;
short mapPosition;
int readingVersion;
wxSnipClassLink *next;
};
class wxDataClassLink
{
public:
wxBufferDataClass *d;
char *name;
int mapPosition;
wxDataClassLink *next;
};
class wxStyleListLink
{
public:
wxStyleList *styleList;
int listId;
wxStyle **styleMap;
int numMappedStyles;
wxStyle *basic; /* used to detect clearing */
wxStyleListLink *next;
};
class wxMediaStream : public wxObject
{
public:
wxStandardSnipClassList *scl;
wxBufferDataClassList *bdl;
char read_format[MRED_FORMAT_STR_LEN + 1];
char read_version[MRED_VERSION_STR_LEN + 1];
wxSnipClassLink *sl;
wxDataClassLink *dl;
wxStyleListLink *ssl;
int styleCount;
wxMediaStream();
~wxMediaStream();
int MapPosition(wxSnipClass *c);
int MapPosition(wxBufferDataClass *d);
int GetHeaderFlag(wxSnipClass *c);
void SetHeaderFlag(wxSnipClass *c);
int ReadingVersion(wxSnipClass *c);
};
/*******************************************************************/
class wxMediaStreamIn : public wxMediaStream
{
wxMediaStreamInBase *f;
long *boundaries;
int boundalloc, boundcount;
int bad;
int items;
void *pos_map;
void Typecheck(char);
void GetNumber(long*, double*);
char *GetAString(long *n, long limit, char *target, int extra, int recur);
void IncItemCount();
void SkipOne(int recur);
char SkipWhitespace(char *buf = NULL);
int IsDelim(char c);
public:
wxMediaStreamIn(wxMediaStreamInBase *base);
~wxMediaStreamIn();
wxMediaStreamIn* Get(long *n, char *str);
wxMediaStreamIn* Get(long*);
wxMediaStreamIn* Get(short*);
wxMediaStreamIn* Get(int*);
wxMediaStreamIn* Get(char*);
wxMediaStreamIn* Get(float*);
wxMediaStreamIn* Get(double*);
wxMediaStreamIn* GetFixed(long*);
char *GetString(long *len, int extra = 0);
char *GetStringPlusOne(long *len);
void SetBoundary(long n);
void RemoveBoundary();
void Skip(long n);
long Tell(void);
void JumpTo(long pos);
Bool Ok(void);
};
class wxMediaStreamOut : public wxMediaStream
{
wxMediaStreamOutBase *f;
int bad, col;
int items; /* position count in items */
void *pos_map; /* map from position count to stream location */
void Typeset(char);
public:
wxMediaStreamOut(wxMediaStreamOutBase *s);
wxMediaStreamOut* Put(long n, char *str, int ds = 0);
wxMediaStreamOut* Put(char *);
wxMediaStreamOut* Put(long);
wxMediaStreamOut* Put(short);
wxMediaStreamOut* Put(int);
wxMediaStreamOut* Put(char);
wxMediaStreamOut* Put(float);
wxMediaStreamOut* Put(double);
wxMediaStreamOut* PutFixed(long);
long Tell(void);
void JumpTo(long pos);
Bool Ok(void);
void PrettyStart();
void PrettyFinish();
};
#endif /* wx_medio */

271
src/mred/wxme/wx_medpb.h
View File

@ -1,271 +0,0 @@
/* Included by wx_media.h */
class wxMediaPasteboard : public wxMediaBuffer
{
protected:
Bool ReadInsert(wxSnip *snip);
void InsertPasteSnip(wxSnip *snip, wxBufferData *);
void InsertPasteString(wxchar *str);
public:
wxMediaPasteboard();
~wxMediaPasteboard();
virtual void OnEvent(wxMouseEvent *event);
virtual void OnChar(wxKeyEvent *event);
virtual wxCursor *AdjustCursor(wxMouseEvent *event);
virtual void Refresh(double localx, double localy, double w, double h,
int show_caret, wxColour *c);
virtual void OwnCaret(Bool ownit);
virtual void BlinkCaret();
virtual void SizeCacheInvalid(void);
void GetExtent(double *w, double *h);
virtual void OnDefaultEvent(wxMouseEvent *event);
virtual void OnDefaultChar(wxKeyEvent *event);
virtual void OnDoubleClick(wxSnip *, wxMouseEvent *event);
/* Callbacks for the wxSnipAdmin: */
virtual Bool ScrollTo(wxSnip *, double localx, double localy,
double w, double h, Bool refresh, int bias = 0);
virtual void SetCaretOwner(wxSnip *, int = wxFOCUS_IMMEDIATE);
virtual void Resized(wxSnip *, Bool redraw_now);
virtual Bool Recounted(wxSnip *, Bool redraw_now);
virtual void NeedsUpdate(wxSnip *, double localx, double localy,
double w, double h);
virtual Bool ReleaseSnip(wxSnip *);
double ScrollLineLocation(long line);
long NumScrollLines();
long FindScrollLine(double y);
wxMediaBuffer *CopySelf(void);
void CopySelfTo(wxMediaBuffer *b);
double GetDescent(void);
double GetSpace(void);
wxchar *GetFlattenedText(long *got=NULL);
void GetCenter(double *x, double *y);
void Clear();
void Cut(Bool extend=FALSE, long time=0);
void Copy(Bool extend=FALSE, long time=0);
void Paste(long time=0);
void PasteSelection(long time=0);
void Kill(long time=0);
void SelectAll(void);
virtual void DoCopy(long time, Bool extend);
virtual void DoPaste(long time);
virtual void DoPasteSelection(long time);
void DoGenericPaste(wxClipboard *cb, long time);
void GenericPaste(Bool x_sel, long time);
void SetSelected(wxSnip *);
void AddSelected(wxSnip *);
void RemoveSelected(wxSnip *);
void NoSelected();
void AddSelected(double x, double y, double w, double h);
void Insert(wxSnip *snip, wxSnip *before, double x, double y);
void Insert(wxSnip *snip, double x, double y);
void Insert(wxSnip *snip);
void Insert(wxSnip *snip, wxSnip *before);
void Delete();
void Delete(wxSnip *snip);
void Remove(wxSnip *snip);
void Erase(void);
void ChangeStyle(wxStyleDelta *delta);
void ChangeStyle(wxStyle *style, wxSnip *snip = NULL);
void ChangeStyle(wxStyleDelta *delta, wxSnip *snip);
Bool ReallyCanEdit(int op);
Bool GetSnipLocation(wxSnip *thesnip, double *x = NULL, double *y = NULL, Bool bottomRight=FALSE);
void SetFilename(char *, Bool temp = FALSE);
Bool WriteToFile(wxMediaStreamOut *);
Bool ReadFromFile(wxMediaStreamIn *, Bool overwritestyle = FALSE);
Bool SavePort(Scheme_Object *port, int format = wxMEDIA_FF_SAME, Bool showErrors = TRUE);
int InsertPort(Scheme_Object *port, int format = wxMEDIA_FF_GUESS, Bool replaceStyles = TRUE);
void StyleHasChanged(wxStyle *style);
/* For making a lot of changes to be displayed at once: */
void BeginEditSequence(Bool undoable = TRUE, Bool interruptSeqs = TRUE);
void EndEditSequence(void);
Bool RefreshDelayed(void);
Bool InEditSequence(void);
Bool LocationsUpToDate(void);
void SetMaxWidth(double w);
void SetMinWidth(double w);
double GetMaxWidth();
double GetMinWidth();
void SetMinHeight(double h);
void SetMaxHeight(double w);
double GetMinHeight();
double GetMaxHeight();
virtual void PrintToDC(wxDC *print, int page = -1);
virtual void *BeginPrint(wxDC *, Bool);
virtual void EndPrint(wxDC *, void *);
virtual Bool HasPrintPage(wxDC *dc, int page);
void AddPasteboardFunctions(wxKeymap *tab);
wxSnip *FindSnip(double x, double y, wxSnip *after=NULL);
wxSnip *FindFirstSnip(void);
Bool IsSelected(wxSnip *asnip);
wxSnip *FindNextSelectedSnip(wxSnip *start);
void MoveTo(wxSnip *, double x, double y);
void Move(wxSnip *, double x, double y);
void Move(double x, double y);
Bool Resize(wxSnip *, double w, double h);
void Raise(wxSnip *snip);
void Lower(wxSnip *snip);
void SetBefore(wxSnip *snip, wxSnip *before);
void SetAfter(wxSnip *snip, wxSnip *after);
Bool GetDragable();
void SetDragable(Bool);
Bool GetSelectionVisible();
void SetSelectionVisible(Bool);
virtual void SetSnipData(wxSnip *, wxBufferData *);
virtual wxBufferData *GetSnipData(wxSnip *snip);
virtual void InvalidateBitmapCache(double x=0.0, double y=0.0,
double w=-1.0, double h=-1.0);
#if ALLOW_X_STYLE_SELECTION
virtual Bool OwnXSelection(Bool on, Bool update, Bool force);
#endif
/* Override these for your own use: */
virtual void OnChange(void);
virtual Bool CanInsert(wxSnip *, wxSnip *, double x, double y);
virtual void OnInsert(wxSnip *, wxSnip *, double x, double y);
virtual void AfterInsert(wxSnip *, wxSnip *, double x, double y);
virtual Bool CanDelete(wxSnip *);
virtual void OnDelete(wxSnip *);
virtual void AfterDelete(wxSnip *);
virtual Bool CanMoveTo(wxSnip *, double x, double y, Bool dragging);
virtual void OnMoveTo(wxSnip *, double x, double y, Bool dragging);
virtual void AfterMoveTo(wxSnip *, double x, double y, Bool dragging);
virtual Bool CanResize(wxSnip *, double w, double h);
virtual void OnResize(wxSnip *, double w, double h);
virtual void AfterResize(wxSnip *, double w, double h, Bool did);
virtual Bool CanReorder(wxSnip *, wxSnip *, Bool);
virtual void OnReorder(wxSnip *, wxSnip *, Bool);
virtual void AfterReorder(wxSnip *, wxSnip *, Bool);
virtual Bool CanSelect(wxSnip *, Bool on);
virtual void OnSelect(wxSnip *, Bool on);
virtual void AfterSelect(wxSnip *, Bool on);
virtual Bool CanInteractiveMove(wxMouseEvent *);
virtual void OnInteractiveMove(wxMouseEvent *);
virtual void AfterInteractiveMove(wxMouseEvent *);
virtual Bool CanInteractiveResize(wxSnip *snip);
virtual void OnInteractiveResize(wxSnip *snip);
virtual void AfterInteractiveResize(wxSnip *snip);
virtual void InteractiveAdjustMouse(double *x, double *y);
virtual void InteractiveAdjustResize(wxSnip *s, double *x, double *y);
virtual void InteractiveAdjustMove(wxSnip *s, double *x, double *y);
void SetScrollStep(double s);
double GetScrollStep(void);
Bool IsLockedForWrite() { return writeLocked; }
Bool IsLockedForFlow() { return flowLocked; }
private:
Bool dragable, selectionVisible;
wxSnip *snips, *lastSnip;
Scheme_Hash_Table *snipLocationList;
wxStandardSnipAdmin *snipAdmin;
long lastTime;
double startX, startY;
double lastX, lastY;
double origX, origY, origW, origH;
double maxWidth, minWidth, minHeight, maxHeight;
Bool keepSize, dragging, rubberband;
int needResize;
wxSnip *resizing;
double sizedxm, sizedym;
double scrollStep;
double totalWidth, totalHeight, realWidth, realHeight;
double updateLeft, updateRight, updateTop, updateBottom;
Bool updateNonempty, noImplicitUpdate;
Bool sizeCacheInvalid;
int writeLocked;
Bool flowLocked;
int sequence;
int delayedscrollbias;
wxSnip *delayedscrollsnip;
double delayedscrollX, delayedscrollY, delayedscrollW, delayedscrollH;
Bool sequenceStreak;
Bool changed;
void InitDragging(wxMouseEvent *);
void FinishDragging(wxMouseEvent *);
void DoSelect(wxSnip *, Bool on);
void DoEventResize(double eventX, double eventY);
void DoEventMove(double eventX, double eventY);
Bool _Delete(wxSnip *, wxDeleteSnipRecord *del);
Bool InsertFile(const char *who, Scheme_Object *f, const char *filename, Bool clearStyles, Bool showErrors);
void Draw(wxDC *dc, double dx, double dy,
double cx, double cy, double cw, double ch,
int show_caret, wxColour *bg);
Bool FindDot(wxSnipLocation *loc, double x, double y,
double *dxm, double *dym);
void Update(double x, double y, double w, double h);
void UpdateSnip(wxSnip *);
void UpdateLocation(wxSnipLocation *);
void UpdateSelected();
void UpdateAll();
void UpdateNeeded();
void CheckRecalc();
void RubberBand(double x, double y, double w, double h);
void _ChangeStyle(wxStyle *style, wxStyleDelta *delta, wxSnip *snip);
wxSnip *SnipSetAdmin(wxSnip *snip, wxSnipAdmin *a);
};

1306
src/mred/wxme/wx_mline.cxx
View File

File diff suppressed because it is too large Load Diff

124
src/mred/wxme/wx_mline.h
View File

@ -1,124 +0,0 @@
#define CURSOR_WIDTH 2
class wxMediaParagraph;
const unsigned long
WXLINE_RED = 0x1,
WXLINE_BLACK = 0x2,
WXLINE_MAX_W_HERE = 0x4,
WXLINE_MAX_W_LEFT = 0x8,
WXLINE_MAX_W_RIGHT = 0x10,
WXLINE_CALC_HERE = 0x20,
WXLINE_CALC_LEFT = 0x40,
WXLINE_CALC_RIGHT = 0x80,
WXLINE_FLOW_HERE = 0x100,
WXLINE_FLOW_LEFT = 0x200,
WXLINE_FLOW_RIGHT = 0x400,
WXLINE_STARTS_PARA = 0x800;
class wxMediaLine
#ifndef MZ_PRECISE_GC
: public gc
#endif
{
public:
wxMediaLine *next, *prev, *parent, *left, *right;
long flags;
wxMediaParagraph *paragraph;
/* relative values: */
long line; // line number
long pos; // starting item position
long scroll; // starting scroll step
long parno; // paragraph number
double y; // starting y location
double maxWidth;
wxSnip *snip, *lastSnip, *scrollSnip;
long len, numscrolls;
double lastH, lastW; /* height/width of last snip in line */
double h, w; /* height/width of line */
double bottombase, topbase; /* bottom baseline, top baseline (relative) */
wxMediaLine();
~wxMediaLine();
wxMediaLine *Insert(wxMediaLine **root, Bool before = TRUE);
void Delete(wxMediaLine **root);
wxMediaLine *FindLine(long line);
wxMediaLine *FindPosition(long pos);
wxMediaLine *FindScroll(long scroll);
wxMediaLine *FindLocation(double y);
wxMediaLine *FindParagraph(long parnp);
long GetLine();
long GetPosition();
long GetScroll();
double GetLocation();
long GetParagraph();
wxMediaParagraph *GetParagraphStyle(Bool *first = NULL);
double ScrollOffset(long p);
long FindExtraScroll(double y);
void SetLength(long len);
void CalcLineLength();
void SetScrollLength(long numScrolls);
void SetHeight(double h);
void SetWidth(double w);
void MarkRecalculate();
void MarkCheckFlow();
void SetStartsParagraph(Bool starts);
inline int StartsParagraph(void)
{ return (flags & WXLINE_STARTS_PARA) ? 1 : 0; };
wxMediaLine *GetRoot();
Bool UpdateFlow(wxMediaLine **root, wxMediaEdit *, double maxw, wxDC *dc);
Bool UpdateGraphics(wxMediaEdit *media, wxDC *dc);
long Number();
wxMediaLine *First();
wxMediaLine *Last();
double GetLeftLocation(double maxWidth);
double GetRightLocation(double maxWidth);
private:
void AdjustOffsets(wxMediaLine *newchild);
void DeadjustOffsets(wxMediaLine *oldchild);
void RotateLeft(wxMediaLine **root);
void RotateRight(wxMediaLine **root);
void AdjustNeedCalc(Bool recur = FALSE);
void AdjustNeedFlow(Bool recur = FALSE);
void AdjustMaxWidth(Bool recur = FALSE);
};
extern wxMediaLine *NIL;
const unsigned long
WXPARA_LEFT = 0x0,
WXPARA_CENTER = 0x1,
WXPARA_RIGHT = 0x2;
class wxMediaParagraph
#ifndef MZ_PRECISE_GC
: public gc
#endif
{
public:
double leftMarginFirst, leftMargin;
double rightMargin;
int alignment;
wxMediaParagraph *Clone();
double GetLineMaxWidth(double maxWidth, Bool first);
};

3025
src/mred/wxme/wx_mpbrd.cxx
View File

File diff suppressed because it is too large Load Diff

3090
src/mred/wxme/wx_mpriv.cxx
View File

File diff suppressed because it is too large Load Diff

39
src/mred/wxme/wx_mpriv.h
View File

@ -1,39 +0,0 @@
#include "wx_mline.h"
#define MAX_COUNT_FOR_SNIP 500
enum {
wxSTREAK_EXCEPT_DELAYED = 1,
wxSTREAK_EXCEPT_KEY_SEQUENCE = 2,
wxSTREAK_EXCEPT_CURSOR = 4
};
class wxClickback : public wxObject
{
public:
wxClickback();
long start, end;
wxClickbackFunc f;
void *data;
Bool callOnDown;
wxStyleDelta *delta;
Bool hilited;
wxList *unhilite;
};
#include "wx_timer.h"
class wxMediaFlashTimer : public wxTimer
{
public:
wxMediaEdit *media;
void Notify(void);
};
#include "wx_clipb.h"
#include "wx_ptreq.h"

1170
src/mred/wxme/wx_msnip.cxx
View File

File diff suppressed because it is too large Load Diff

36
src/mred/wxme/wx_mtype.h
View File

@ -1,36 +0,0 @@
#define USE_OLD_TYPE_SYSTEM 1
#define wxTYPE_MEDIA_CANVAS 344
#define wxTYPE_MEDIA_BUFFER 345
#define wxTYPE_MEDIA_EDIT 346
#define wxTYPE_MEDIA_PASTEBOARD 347
#define wxTYPE_SNIP 348
#define wxTYPE_TEXT_SNIP 349
#define wxTYPE_TAB_SNIP 350
#define wxTYPE_MEDIA_SNIP 351
#define wxTYPE_SNIP_CLASS 352
#define wxTYPE_MEDIA_ADMIN 353
#define wxTYPE_MEDIA_SNIP_ADMIN 354
#define wxTYPE_MEDIA_SNIP_MEDIA_ADMIN 355
#define wxTYPE_CANVAS_MEDIA_ADMIN 356
#define wxTYPE_MEDIA_STREAM_IN 357
#define wxTYPE_MEDIA_STREAM_OUT 358
#define wxTYPE_MEDIA_STREAM_IN_BASE 359
#define wxTYPE_MEDIA_STREAM_OUT_BASE 360
#define wxTYPE_MEDIA_STREAM_IN_FILE_BASE 361
#define wxTYPE_MEDIA_STREAM_IN_STRING_BASE 362
#define wxTYPE_MEDIA_STREAM_OUT_FILE_BASE 363
#define wxTYPE_MEDIA_STREAM_OUT_STRING_BASE 364
#define wxTYPE_KEYMAP 365
#define wxTYPE_MULT_COLOUR 366
#define wxTYPE_ADD_COLOUR 367
#define wxTYPE_STYLE 368
#define wxTYPE_STYLE_DELTA 369
#define wxTYPE_STYLE_LIST 370
#define wxTYPE_IMAGE_SNIP 371
#define wxTYPE_BUFFER_DATA 372
#define wxTYPE_BUFFER_DATA_CLASS 373
#define wxTYPE_BUFFER_DATA_CLASS_LIST 374
#define wxTYPE_WORDBREAK_MAP 375
#define wxTYPE_SNIP_CLASS_LIST 376

8
src/mred/wxme/wx_ptreq.h
View File

@ -1,8 +0,0 @@
#ifndef PTREQ
/* Comparing pointers: */
#define PTREQ(x, y) ((x) == (y))
#define PTRNE(x, y) ((x) != (y))
#endif

2211
src/mred/wxme/wx_snip.cxx
View File

File diff suppressed because it is too large Load Diff

541
src/mred/wxme/wx_snip.h
View File

@ -1,541 +0,0 @@
#ifndef __WX_SNIP__
#define __WX_SNIP__
class wxSnipAdmin;
/* The default is that none of these flags are on: */
enum {
wxSNIP_IS_TEXT = 0x1,
wxSNIP_CAN_APPEND = 0x2,
wxSNIP_INVISIBLE = 0x4,
wxSNIP_NEWLINE = 0x8, /* Soft newline, typically inserted by wxMediaEdit */
wxSNIP_HARD_NEWLINE = 0x10, /* => Snip must be follwed by newline */
wxSNIP_HANDLES_EVENTS = 0x20,
wxSNIP_WIDTH_DEPENDS_ON_X = 0x40,
wxSNIP_HEIGHT_DEPENDS_ON_Y = 0x80,
wxSNIP_WIDTH_DEPENDS_ON_Y = 0x100,
wxSNIP_HEIGHT_DEPENDS_ON_X = 0x200,
wxSNIP_ANCHORED = 0x400,
wxSNIP_USES_BUFFER_PATH = 0x800,
wxSNIP_CAN_SPLIT = 0x1000, /* safety feature */
wxSNIP_OWNED = 0x2000,
wxSNIP_CAN_DISOWN = 0x4000
};
extern void wxInitSnips(void);
#define WRITE_FUNC \
Bool wxmbWriteSnipsToFile(class wxMediaStreamOut *, \
class wxStyleList *, \
class wxList *, class wxSnip *, \
class wxSnip *, wxList *, \
class wxMediaBuffer *)
class wxSnip;
extern WRITE_FUNC;
class wxSnipClass : public wxObject
{
public:
char *classname;
int version;
/* If this flag is TRUE, then files saved to disk will be written
assuming that, when the file is read from disk, the class will
always be present. */
Bool required;
wxSnipClass();
virtual wxSnip *Read(wxMediaStreamIn *) = 0;
virtual Bool ReadHeader(wxMediaStreamIn *);
virtual Bool WriteHeader(wxMediaStreamOut *);
int ReadingVersion(wxMediaStreamIn *);
};
class wxSnipClassList : public /* should be private */ wxList
{
public:
wxSnipClassList(void);
~wxSnipClassList();
wxSnipClass *Find(char *name);
short FindPosition(wxSnipClass *);
int ReadingVersion(wxSnipClass *);
void Add(wxSnipClass *snipclass); /* Checks for duplicates */
int Number(void);
wxSnipClass *Nth(int);
};
enum {
wxRESET_NO_MSG = 0,
wxRESET_DONE_READ,
wxRESET_DONE_WRITE
};
class wxStandardSnipClassList : public wxSnipClassList
{
private:
wxList *unknowns;
public:
wxStandardSnipClassList(void);
void ResetHeaderFlags(wxMediaStream *s);
Bool Write(wxMediaStreamOut *f);
Bool Read(wxMediaStreamIn *f);
wxSnipClass *FindByMapPosition(wxMediaStream *f, short n);
};
extern wxStandardSnipClassList *wxMakeTheSnipClassList();
extern wxStandardSnipClassList *wxGetTheSnipClassList();
#define wxTheSnipClassList (*wxGetTheSnipClassList())
extern wxSnipClass *wxGetSnipClass(const char *name);
/******************************************************************/
class wxMediaLine;
class wxSnip : public wxObject
{
private:
friend class wxMediaEdit;
friend class wxMediaPasteboard;
friend class wxMediaBuffer;
friend class wxMediaLine;
friend WRITE_FUNC;
/* For use only by the owning wxMediaBuffer */
wxSnip *prev, *next;
wxMediaLine *line;
void Init(void);
protected:
wxSnipAdmin *admin;
public:
long count;
long flags;
wxSnipClass *snipclass;
wxStyle *style;
wxSnip();
wxSnip(Bool cleanup);
~wxSnip();
wxSnip *Next(void);
wxSnip *Previous(void);
wxSnipAdmin *GetAdmin(void);
virtual void SetAdmin(wxSnipAdmin *);
Bool IsOwned(void);
Bool ReleaseFromOwner(void);
void SetCount(long count);
void SetFlags(long flags);
virtual void OnEvent(wxDC *dc, double x, double y,
double mediax, double mediay,
wxMouseEvent *event);
virtual void OnChar(wxDC *dc, double x, double y,
double mediax, double mediay,
wxKeyEvent *event);
virtual wxCursor *AdjustCursor(wxDC *dc, double x, double y,
double mediax, double mediay,
wxMouseEvent *event);
virtual void OwnCaret(Bool);
virtual void BlinkCaret(wxDC *dc, double x, double y);
virtual void DoEdit(int op, Bool recursive = TRUE, long time = 0);
virtual Bool CanEdit(int op, Bool recursive = TRUE);
virtual void DoFont(int op, Bool recursive = TRUE);
virtual int Match(wxSnip *other);
virtual void SizeCacheInvalid(void);
virtual void GetExtent(wxDC *dc,
double x, double y,
double *w = NULL, double *h = NULL,
double *descent = NULL, double *space = NULL,
double *lspace = NULL, double *rspace = NULL);
virtual double PartialOffset(wxDC *, double x, double y, long);
virtual void Draw(wxDC *dc, double x, double y,
double,double,double,double,
double dx, double xy,
int show_caret);
virtual void Split(long position, wxSnip **first, wxSnip **second);
virtual wxSnip *MergeWith(wxSnip *pred);
virtual void GetTextBang(wxchar *s, long offset, long num, long dt);
virtual wxchar *GetText(long offset, long num, Bool flattened = FALSE, long *got=NULL);
virtual char *GetTextUTF8(long offset, long num, Bool flattened = FALSE, long *got=NULL);
virtual wxSnip *Copy();
virtual void Write(wxMediaStreamOut *f);
virtual Bool Resize(double w, double h);
virtual long GetNumScrollSteps();
virtual long FindScrollStep(double y);
virtual double GetScrollStepOffset(long i);
virtual void SetUnmodified();
void SetStyle(wxStyle *s);
protected:
void Copy(wxSnip *); /* Copy basic values into given snip */
};
class wxInternalSnip : public wxSnip
{
public:
wxInternalSnip();
wxInternalSnip(Bool cleanup);
void SetCount(long count);
};
class wxTextSnip : public wxInternalSnip
{
protected:
double w; /* < 0 => need to recalc size */
void GetTextExtent(wxDC *dc, int count, double *wo);
void Init(long allocsize);
public:
long dtext;
wxchar *buffer;
long allocated;
wxTextSnip(long allocsize = 0);
wxTextSnip(wxchar *initstring, long len);
wxTextSnip(char *initstring, long len);
~wxTextSnip();
virtual void SizeCacheInvalid(void);
virtual void GetExtent(wxDC *dc,
double x, double y,
double *w = NULL, double *h = NULL,
double *descent = NULL, double *space = NULL,
double *lspace = NULL, double *rspace = NULL);
virtual double PartialOffset(wxDC *, double x, double y, long);
virtual void Draw(wxDC *dc, double x, double y,
double,double,double,double,
double dx, double dy, int);
virtual void Split(long position, wxSnip **first, wxSnip **second);
virtual wxSnip *MergeWith(wxSnip *pred);
virtual void Insert(wxchar *str, long len, long pos = 0);
virtual void InsertWithOffset(wxchar *str, long len, long delta, long pos = 0);
virtual void InsertUTF8(char *str, long len, long pos = 0);
virtual void Read(long len, wxMediaStreamIn *f);
virtual void GetTextBang(wxchar *s, long offset, long num, long dt);
virtual wxchar *GetText(long offset, long num, Bool flattened = FALSE, long *got=NULL);
virtual wxSnip *Copy(void);
virtual void Write(wxMediaStreamOut *f);
#ifdef MEMORY_USE_METHOD
long MemoryUse(void);
#endif
protected:
void Copy(wxTextSnip *); /* Copy text values into given snip */
};
class wxTabSnip : public wxTextSnip
{
public:
wxTabSnip();
virtual void GetExtent(wxDC *dc,
double x, double y,
double *w = NULL, double *h = NULL,
double *descent = NULL, double *space = NULL,
double *lspace = NULL, double *rspace = NULL);
virtual double PartialOffset(wxDC *, double x, double y, long);
virtual void Draw(wxDC *dc, double x, double y,
double,double,double,double,
double dx, double dy, int);
virtual wxSnip *Copy();
};
class wxImageSnip : public wxInternalSnip
{
private:
char *filename;
long filetype; /* file != NULL => type of file, otherwise loaded 1 => XBM and 2 => XPM */
wxBitmap *bm, *mask;
Bool relativePath;
void Init(void);
protected:
double w, h, vieww, viewh, viewdx, viewdy;
Bool contentsChanged;
public:
wxImageSnip(char *name = NULL, long type = 0, Bool relative = FALSE, Bool inlineImg = TRUE);
wxImageSnip(wxBitmap *bm, wxBitmap *mask = NULL);
~wxImageSnip();
virtual void SizeCacheInvalid(void);
virtual void GetExtent(wxDC *dc,
double x, double y,
double *w = NULL, double *h = NULL,
double *descent = NULL, double *space = NULL,
double *lspace = NULL, double *rspace = NULL);
virtual void Draw(wxDC *dc, double x, double y,
double,double,double,double,
double dx, double dy, int);
virtual wxSnip *Copy(void);
virtual void Write(wxMediaStreamOut *f);
void LoadFile(char *name, long type, Bool relative = FALSE, Bool inlineImg = TRUE);
char *GetFilename(Bool *relative);
long GetFiletype();
void SetBitmap(wxBitmap *, wxBitmap *mask = NULL, int refresh = TRUE);
wxBitmap *GetSnipBitmap();
wxBitmap *GetSnipBitmapMask();
void SetOffset(double dx, double dy);
virtual Bool Resize(double w, double h);
virtual long GetNumScrollSteps();
virtual long FindScrollStep(double y);
virtual double GetScrollStepOffset(long i);
virtual void SetAdmin(wxSnipAdmin *);
protected:
void Copy(wxImageSnip *);
};
class wxSnipAdmin : public wxObject
{
public:
inline wxSnipAdmin();
virtual wxMediaBuffer *GetMedia(void) = 0;
virtual wxDC *GetDC() = 0;
virtual void GetViewSize(double *h, double *w) = 0;
virtual void GetView(double *x, double *y, double *h, double *w, wxSnip *snip = NULL) = 0;
virtual Bool ScrollTo(wxSnip *, double localx, double localy,
double w, double h, Bool refresh, int bias = 0) = 0;
virtual void SetCaretOwner(wxSnip *, int = wxFOCUS_IMMEDIATE) = 0;
virtual void Resized(wxSnip *, Bool redraw_now) = 0;
virtual Bool Recounted(wxSnip *, Bool redraw_now) = 0;
virtual void NeedsUpdate(wxSnip *, double localx, double localy,
double w, double h) = 0;
virtual Bool ReleaseSnip(wxSnip *) = 0;
virtual void UpdateCursor() = 0;
virtual Bool PopupMenu(void *m, wxSnip *s, double x, double y) = 0;
virtual void Modified(wxSnip *s, Bool mod) = 0;
};
inline wxSnipAdmin::wxSnipAdmin()
: wxObject(WXGC_NO_CLEANUP)
{
}
#define wxMSNIPBOX_XMARGIN 5
#define wxMSNIPBOX_YMARGIN 5
#define wxMSNIPBOX_XINSET 1
#define wxMSNIPBOX_YINSET 1
class wxMediaSnipMediaAdmin;
class wxMediaSnip : public wxInternalSnip
{
friend class wxMediaSnipMediaAdmin;
wxMediaBuffer *me;
wxMediaSnipMediaAdmin *myAdmin;
#define TF_Flag(var) unsigned var : 1
TF_Flag( withBorder );
TF_Flag( tightFit );
TF_Flag( alignTopLine );
TF_Flag( useStyleBG );
#undef TF_Flag
int leftMargin, topMargin, rightMargin, bottomMargin;
int leftInset, topInset, rightInset, bottomInset;
double minWidth, maxWidth, minHeight, maxHeight;
public:
wxMediaSnip(wxMediaBuffer *useme = NULL,
Bool withBorder = TRUE,
int leftMargin = wxMSNIPBOX_XMARGIN,
int topMargin = wxMSNIPBOX_YMARGIN,
int rightMargin = wxMSNIPBOX_XMARGIN,
int bottomMargin = wxMSNIPBOX_YMARGIN,
int leftInset = wxMSNIPBOX_XINSET,
int topInset = wxMSNIPBOX_YINSET,
int rightInset = wxMSNIPBOX_XINSET,
int bottomInset = wxMSNIPBOX_YINSET,
double w = -1, double W = -1,
double h = -1, double H = -1);
~wxMediaSnip();
virtual void SetAdmin(wxSnipAdmin *a);
virtual void OnEvent(wxDC *, double, double, double,double, wxMouseEvent *event);
virtual void OnChar(wxDC *, double, double, double, double, wxKeyEvent *event);
virtual wxCursor *AdjustCursor(wxDC *, double, double, double,double, wxMouseEvent *event);
virtual void OwnCaret(Bool);
virtual void BlinkCaret(wxDC *dc, double x, double y);
virtual void DoEdit(int op, Bool recursive = TRUE, long time = 0);
virtual Bool CanEdit(int op, Bool recursive = TRUE);
virtual void DoFont(int op, Bool recursive = TRUE);
virtual Bool Match(wxSnip *other);
virtual void SizeCacheInvalid(void);
virtual wxchar *GetText(long offset, long num, Bool flattened = FALSE, long *got = NULL);
virtual void GetExtent(wxDC *dc,
double x, double y,
double *w = NULL, double *h = NULL,
double *descent = NULL, double *space = NULL,
double *lspace = NULL, double *rspace = NULL);
virtual void Draw(wxDC *dc, double x, double y,
double, double, double, double, double dx, double dy,
int show_caret);
virtual wxSnip *Copy(void);
virtual void Write(wxMediaStreamOut *f);
virtual long GetNumScrollSteps();
virtual long FindScrollStep(double y);
virtual double GetScrollStepOffset(long i);
void SetMaxWidth(double);
void SetMaxHeight(double);
double GetMaxWidth(void);
double GetMaxHeight(void);
void SetMinWidth(double);
void SetMinHeight(double);
double GetMinWidth(void);
double GetMinHeight(void);
Bool GetTightTextFit(void);
void SetTightTextFit(Bool);
Bool GetAlignTopLine(void);
void SetAlignTopLine(Bool);
void ShowBorder(Bool show);
Bool BorderVisible();
void UseStyleBG(Bool useit);
Bool StyleBGUsed();
void SetMargin(int lm, int tm, int rm, int bm);
void GetMargin(int *lm, int *tm, int *rm, int *bm);
void SetInset(int lm, int tm, int rm, int bm);
void GetInset(int *li, int *ti, int *ri, int *bi);
virtual Bool Resize(double w, double h);
void SetUnmodified();
wxMediaBuffer *GetThisMedia(void);
void SetMedia(wxMediaBuffer *b);
void RequestRefresh();
};
/**********************************************************************/
class wxMediaStreamOut;
class wxBufferData;
class wxBufferDataClass : public wxObject
{
private:
friend class wxBufferDataClassList;
friend class wxMediaBuffer;
friend WRITE_FUNC;
friend Bool wxmbWriteBufferData(wxMediaStreamOut *, wxBufferData *data);
public:
char *classname;
Bool required;
wxBufferDataClass();
virtual wxBufferData *Read(wxMediaStreamIn *) = 0;
};
class wxBufferData : public wxObject
{
public:
wxBufferDataClass *dataclass;
wxBufferData *next; /* Used to chain them in a list */
wxBufferData();
~wxBufferData();
virtual Bool Write(wxMediaStreamOut *) = 0;
};
class wxBufferDataClassList : public /* should be private */ wxList
{
private:
wxList *unknowns;
public:
wxBufferDataClassList();
~wxBufferDataClassList();
wxBufferDataClass *Find(char *name);
short FindPosition(wxBufferDataClass *);
void Add(wxBufferDataClass *dataclass); /* Checks for duplicates */
int Number(void);
wxBufferDataClass *Nth(int);
Bool Write(wxMediaStreamOut *f);
Bool Read(wxMediaStreamIn *f);
wxBufferDataClass *FindByMapPosition(wxMediaStream *f, short n);
};
extern wxBufferDataClassList *wxMakeTheBufferDataClassList();
extern wxBufferDataClassList *wxGetTheBufferDataClassList();
#define wxTheBufferDataClassList (*wxGetTheBufferDataClassList())
extern wxBufferDataClass *wxGetEditorDataClass(const char *name);
/**********************************************************************/
class wxLocationBufferData : public wxBufferData
{
public:
double x, y;
wxLocationBufferData();
Bool Write(wxMediaStreamOut *);
};
#endif /* __WX_SNIP__ */

1894
src/mred/wxme/wx_style.cxx
View File

File diff suppressed because it is too large Load Diff

258
src/mred/wxme/wx_style.h
View File

@ -1,258 +0,0 @@
#ifndef __WXME_STYLE__
#define __WXME_STYLE__
#include "wx_list.h"
#include "wx_gdi.h"
#include "wx_dc.h"
#include "wx_utils.h"
#ifndef WXGC_NO_CLEANUP
#define WXGC_NO_CLEANUP /* empty */
#endif
#define wxBASE (-1)
#ifndef wxALIGN_TOP
enum {
wxALIGN_TOP,
wxALIGN_BOTTOM
# ifndef wxALIGN_CENTER
, wxALIGN_CENTER
# endif
};
#endif
/* Simple style change commands */
enum {
wxCHANGE_NOTHING,
wxCHANGE_STYLE,
wxCHANGE_WEIGHT,
wxCHANGE_UNDERLINE,
wxCHANGE_SIZE,
wxCHANGE_FAMILY,
wxCHANGE_ALIGNMENT,
wxCHANGE_BOLD,
wxCHANGE_ITALIC,
wxCHANGE_SMOOTHING,
wxCHANGE_TOGGLE_STYLE,
wxCHANGE_TOGGLE_WEIGHT,
wxCHANGE_TOGGLE_SMOOTHING,
wxCHANGE_TOGGLE_UNDERLINE,
wxCHANGE_BIGGER,
wxCHANGE_SMALLER,
wxCHANGE_NORMAL,
wxCHANGE_NORMAL_COLOUR,
wxCHANGE_SIP,
wxCHANGE_TOGGLE_SIP,
};
class wxMultColour : public wxObject
{
public:
double r, g, b;
inline wxMultColour();
void Get(double *r, double *g, double *b);
void Set(double r, double g, double b);
};
inline wxMultColour::wxMultColour()
: wxObject(WXGC_NO_CLEANUP)
{
}
class wxAddColour : public wxObject
{
public:
short r, g, b;
inline wxAddColour();
void Get(short *r, short *g, short *b);
void Set(short r, short g, short b);
};
inline wxAddColour::wxAddColour()
: wxObject(WXGC_NO_CLEANUP)
{
}
class wxStyleDelta : public wxObject
{
public:
int family;
char *face;
double sizeMult;
int sizeAdd;
int weightOn; /* On == Off => Toggle */
int weightOff; /* On & Off, but On != Off => Converting toggle */
int styleOn;
int styleOff;
int smoothingOn;
int smoothingOff;
Bool underlinedOn;
Bool underlinedOff;
Bool sipOn;
Bool sipOff;
Bool transparentTextBackingOn;
Bool transparentTextBackingOff;
wxMultColour *foregroundMult, *backgroundMult;
wxAddColour *foregroundAdd, *backgroundAdd;
int alignmentOn;
int alignmentOff;
wxStyleDelta(int changeCommand = wxCHANGE_NOTHING, int param = 0);
~wxStyleDelta();
wxStyleDelta *SetDelta(int changeCommand, int param = 0);
wxStyleDelta *SetDeltaFace(char *name, int family = wxDEFAULT);
wxStyleDelta *SetDeltaBackground(char *name);
wxStyleDelta *SetDeltaBackground(wxColour *colour);
wxStyleDelta *SetDeltaForeground(char *name);
wxStyleDelta *SetDeltaForeground(wxColour *colour);
Bool Collapse(wxStyleDelta *delta);
Bool Equal(wxStyleDelta *delta);
void Copy(wxStyleDelta *delta);
};
class wxStyleList;
class wxStyle : public wxObject
{
friend class wxStyleList;
private:
wxStyleList *styleList; /* Points back to the list owning the style */
char *name;
wxStyle *baseStyle;
wxStyle *join_shiftStyle;
wxStyleDelta *nonjoin_delta;
/* cache computation: */
Bool transText;
wxColour *foreground, *background;
wxFont *font;
wxPen *pen;
wxBrush *brush;
int alignment;
int cached_sizes;
double textWidth, textHeight, textDescent, textSpace;
wxList *children;
void Update(wxStyle *basic = NULL, wxStyle *target = NULL,
Bool propogate = TRUE, Bool topLevel = TRUE, Bool send_notify = TRUE);
void ResetTextMetrics(wxDC *dc);
public:
wxStyle();
~wxStyle();
char *GetName();
int GetFamily();
char *GetFace();
int GetSize();
int GetWeight();
int GetStyle();
int GetSmoothing();
Bool GetUnderlined();
Bool GetSizeInPixels();
wxFont *GetFont();
wxColour *GetForeground();
wxColour *GetBackground();
int GetAlignment();
Bool GetTransparentTextBacking();
wxStyle *GetBaseStyle(void);
void SetBaseStyle(wxStyle *baseStyle);
Bool IsJoin(void);
void GetDelta(wxStyleDelta *delta);
void SetDelta(wxStyleDelta *delta);
wxStyle *GetShiftStyle();
void SetShiftStyle(wxStyle *);
void SwitchTo(wxDC *dc, wxStyle *oldStyle);
double GetTextWidth(wxDC *dc);
double GetTextHeight(wxDC *dc);
double GetTextDescent(wxDC *dc);
double GetTextSpace(wxDC *dc);
};
typedef void (*wxStyleNotifyFunc)(wxStyle *which, void *data);
class wxMediaStream;
class wxStyleList : public wxList /* should be private */
{
wxStyle *basic;
wxList *notifications;
wxStyle *DoNamedStyle(char *name, wxStyle *plainStyle, Bool replace);
public:
wxStyleList();
~wxStyleList();
void Copy(wxStyleList *other);
wxStyle *BasicStyle(void);
int Number(void);
/* Called automatically by style: */
void StyleWasChanged(wxStyle *which);
void StyleHasNewChild(wxStyle *s, wxStyle *c);
Bool CheckForLoop(wxStyle *s, wxStyle *p);
wxStyle *FindOrCreateStyle(wxStyle *baseStyle, wxStyleDelta *delta);
wxStyle *FindOrCreateJoinStyle(wxStyle *baseStyle, wxStyle *shiftStyle);
wxStyle *FindNamedStyle(char *name);
wxStyle *NewNamedStyle(char *name, wxStyle *plainStyle);
wxStyle *ReplaceNamedStyle(char *name, wxStyle *plainStyle);
wxStyle *Convert(wxStyle *, Bool overwrite = FALSE);
void *NotifyOnChange(wxStyleNotifyFunc f, void *data, int weak = 0);
void ForgetNotification(void *id);
wxStyle *IndexToStyle(int i);
int StyleToIndex(wxStyle *);
Bool WriteToFile(class wxMediaStreamOut *f);
wxStyle *MapIndexToStyle(wxMediaStream *f, int i, long listId);
};
extern wxStyleList *wxTheStyleList;
void wxInitStyles(void);
wxStyleList *wxReadStyleList(class wxMediaStreamIn *f);
class wxMediaStream;
/* Internal use only */
Bool wxmbWriteStylesToFile(wxStyleList *styleList, class wxMediaStreamOut *f);
wxStyleList *wxmbReadStylesFromFile(wxStyleList *, class wxMediaStreamIn *f, Bool overwritename, long *listId);
void wxmbSetupStyleReadsWrites(wxMediaStream *);
void wxmbDoneStyleReadsWrites(wxMediaStream *);
#endif

71
src/mred/wxs/Makefile.in
View File

@ -57,7 +57,6 @@ WXPRECOMPDIR = ../../wxmac/src
WXSCHEMEHEADERS = $(srcdir)/wxscheme.h $(srcdir)/../../mzscheme/src/stypes.h $(srcdir)/../../mzscheme/utils/xcglue.h \
$(srcdir)/../../mzscheme/include/scheme.h $(OBJECTHEADER_@WXVARIANT@) \
$(srcdir)/../../wxcommon/wxGC.h $(srcdir)/../../wxcommon/wx_list.h @WXPRECOMP@
MEDIAHEADERS = $(srcdir)/../wxme/wx_media.h $(srcdir)/../wxme/wx_medad.h $(srcdir)/../wxme/wx_snip.h
WINDOWHEADERS_wx_xt = $(srcdir)/../../wxxt/src/Windows/Window.h
@ -92,35 +91,35 @@ CLIPBHEADER = $(CLIPBHEADER_@WXVARIANT@)
OBJECTS = xcglue.@LTO@ wxs_bmap.@LTO@ wxs_butn.@LTO@ wxs_chce.@LTO@ wxs_ckbx.@LTO@ wxs_cnvs.@LTO@ \
wxs_dc.@LTO@ wxs_evnt.@LTO@ wxs_fram.@LTO@ wxs_gage.@LTO@ wxs_gdi.@LTO@ wxs_glob.@LTO@ \
wxs_item.@LTO@ wxs_lbox.@LTO@ wxs_madm.@LTO@ wxs_mede.@LTO@ wxs_medi.@LTO@ wxs_menu.@LTO@ \
wxs_mio.@LTO@ wxs_misc.@LTO@ wxs_mpb.@LTO@ wxs_obj.@LTO@ wxs_panl.@LTO@ wxs_rado.@LTO@ wxs_slid.@LTO@ \
wxs_snip.@LTO@ wxs_styl.@LTO@ wxs_tabc.@LTO@ wxs_win.@LTO@ wxscheme.@LTO@
wxs_item.@LTO@ wxs_lbox.@LTO@ wxs_menu.@LTO@ \
wxs_misc.@LTO@ wxs_obj.@LTO@ wxs_panl.@LTO@ wxs_rado.@LTO@ wxs_slid.@LTO@ \
wxs_tabc.@LTO@ wxs_win.@LTO@ wxscheme.@LTO@
SOURCES = $(srcdir)/wxs_bmap.cxx $(srcdir)/wxs_butn.cxx $(srcdir)/wxs_chce.cxx $(srcdir)/wxs_ckbx.cxx \
$(srcdir)/wxs_cnvs.cxx $(srcdir)/wxs_dc.cxx $(srcdir)/wxs_evnt.cxx $(srcdir)/wxs_fram.cxx \
$(srcdir)/wxs_gage.cxx $(srcdir)/wxs_gdi.cxx $(srcdir)/wxs_glob.cxx $(srcdir)/wxs_item.cxx \
$(srcdir)/wxs_lbox.cxx $(srcdir)/wxs_madm.cxx $(srcdir)/wxs_mede.cxx $(srcdir)/wxs_medi.cxx \
$(srcdir)/wxs_menu.cxx $(srcdir)/wxs_mio.cxx $(srcdir)/wxs_misc.cxx $(srcdir)/wxs_mpb.cxx \
$(srcdir)/wxs_lbox.cxx \
$(srcdir)/wxs_menu.cxx $(srcdir)/wxs_misc.cxx \
$(srcdir)/wxs_obj.cxx $(srcdir)/wxs_panl.cxx $(srcdir)/wxs_rado.cxx $(srcdir)/wxs_slid.cxx \
$(srcdir)/wxs_snip.cxx $(srcdir)/wxs_styl.cxx $(srcdir)/wxs_tabc.cxx $(srcdir)/wxs_win.cxx $(srcdir)/wxscheme.cxx
$(srcdir)/wxs_tabc.cxx $(srcdir)/wxs_win.cxx $(srcdir)/wxscheme.cxx
SCRIPTS = $(srcdir)/wxs_bmap.xc $(srcdir)/wxs_butn.xc $(srcdir)/wxs_chce.xc $(srcdir)/wxs_ckbx.xc \
$(srcdir)/wxs_cnvs.xc $(srcdir)/wxs_dc.xc $(srcdir)/wxs_evnt.xc $(srcdir)/wxs_fram.xc \
$(srcdir)/wxs_gage.xc $(srcdir)/wxs_gdi.xc $(srcdir)/wxs_glob.xc $(srcdir)/wxs_item.xc \
$(srcdir)/wxs_lbox.xc $(srcdir)/wxs_madm.xc $(srcdir)/wxs_mede.xc $(srcdir)/wxs_medi.xc \
$(srcdir)/wxs_menu.xc $(srcdir)/wxs_mio.xc $(srcdir)/wxs_misc.xc $(srcdir)/wxs_mpb.xc \
$(srcdir)/wxs_lbox.xc \
$(srcdir)/wxs_menu.xc $(srcdir)/wxs_misc.xc \
$(srcdir)/wxs_obj.xc $(srcdir)/wxs_panl.xc $(srcdir)/wxs_rado.xc $(srcdir)/wxs_slid.xc \
$(srcdir)/wxs_snip.xc $(srcdir)/wxs_styl.xc $(srcdir)/wxs_tabc.xc $(srcdir)/wxs_win.xc
$(srcdir)/wxs_tabc.xc $(srcdir)/wxs_win.xc
# Order matters: superclasses first
SSDESCS = $(srcdir)/wxs_obj.ss $(srcdir)/wxs_win.ss $(srcdir)/wxs_item.ss $(srcdir)/wxs_medi.ss \
SSDESCS = $(srcdir)/wxs_obj.ss $(srcdir)/wxs_win.ss $(srcdir)/wxs_item.ss \
$(srcdir)/wxs_bmap.ss $(srcdir)/wxs_butn.ss $(srcdir)/wxs_chce.ss $(srcdir)/wxs_ckbx.ss \
$(srcdir)/wxs_cnvs.ss $(srcdir)/wxs_dc.ss $(srcdir)/wxs_evnt.ss $(srcdir)/wxs_fram.ss \
$(srcdir)/wxs_gage.ss $(srcdir)/wxs_gdi.ss $(srcdir)/wxs_glob.ss \
$(srcdir)/wxs_lbox.ss $(srcdir)/wxs_madm.ss $(srcdir)/wxs_mede.ss \
$(srcdir)/wxs_menu.ss $(srcdir)/wxs_mio.ss $(srcdir)/wxs_misc.ss $(srcdir)/wxs_mpb.ss \
$(srcdir)/wxs_lbox.ss \
$(srcdir)/wxs_menu.ss $(srcdir)/wxs_misc.ss \
$(srcdir)/wxs_panl.ss $(srcdir)/wxs_rado.ss $(srcdir)/wxs_slid.ss \
$(srcdir)/wxs_snip.ss $(srcdir)/wxs_styl.ss $(srcdir)/wxs_tabc.ss
$(srcdir)/wxs_tabc.ss
all: libwxscheme.@LIBSFX@
@ -183,20 +182,10 @@ $(srcdir)/wxs_item.cxx : $(srcdir)/wxs_item.xc $(ITEM_DEPEND) $(XCDEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_item.cxx ; else $(XCTOCXX) $(srcdir)/wxs_item.xc ; fi
$(srcdir)/wxs_lbox.cxx : $(srcdir)/wxs_lbox.xc $(srcdir)/range.xci $(XCDEPEND) $(CB_DEPEND) $(LIST_DEPEND) $(ITEM_DEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_lbox.cxx ; else $(XCTOCXX) $(srcdir)/wxs_lbox.xc ; fi
$(srcdir)/wxs_madm.cxx : $(srcdir)/wxs_madm.xc $(srcdir)/wxs_madm.xci $(srcdir)/wxs_fcs.xci $(srcdir)/wxs_bkt.xci $(srcdir)/wxs_win.xci $(XCDEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_madm.cxx ; else $(XCTOCXX) $(srcdir)/wxs_madm.xc ; fi
$(srcdir)/wxs_medi.cxx : $(srcdir)/wxs_medi.xc $(srcdir)/wxs_mbuf.xci $(srcdir)/wxs_fcs.xci $(srcdir)/wxs_eds.xci $(srcdir)/wxs_cret.xci $(srcdir)/wxs_eop.xci $(XCDEPEND) $(LIST_DEPEND) $(srcdir)/wxs_bmt.xci
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_medi.cxx ; else $(XCTOCXX) $(srcdir)/wxs_medi.xc ; fi
$(srcdir)/wxs_mede.cxx : $(srcdir)/wxs_mede.xc $(srcdir)/wxs_mbuf.xci $(srcdir)/wxs_fcs.xci $(srcdir)/wxs_eds.xci $(srcdir)/wxs_cret.xci $(srcdir)/wxs_bkt.xci $(XCDEPEND) $(LIST_DEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_mede.cxx ; else $(XCTOCXX) $(srcdir)/wxs_mede.xc ; fi
$(srcdir)/wxs_menu.cxx : $(srcdir)/wxs_menu.xc $(XCDEPEND) $(CB_DEPEND) $(LIST_DEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_menu.cxx ; else $(XCTOCXX) $(srcdir)/wxs_menu.xc ; fi
$(srcdir)/wxs_mio.cxx : $(srcdir)/wxs_mio.xc $(XCDEPEND) $(LIST_DEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_mio.cxx ; else $(XCTOCXX) $(srcdir)/wxs_mio.xc ; fi
$(srcdir)/wxs_misc.cxx : $(srcdir)/wxs_misc.xc $(srcdir)/wxs_espc.xci $(XCDEPEND) $(CB_DEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_misc.cxx ; else $(XCTOCXX) $(srcdir)/wxs_misc.xc ; fi
$(srcdir)/wxs_mpb.cxx : $(srcdir)/wxs_mpb.xc $(srcdir)/wxs_mbuf.xci $(srcdir)/wxs_eds.xci $(srcdir)/wxs_cret.xci $(srcdir)/wxs_fcs.xci $(XCDEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_mpb.cxx ; else $(XCTOCXX) $(srcdir)/wxs_mpb.xc ; fi
$(srcdir)/wxs_obj.cxx : $(srcdir)/wxs_obj.xc $(XCDEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_obj.cxx ; else $(XCTOCXX) $(srcdir)/wxs_obj.xc ; fi
$(srcdir)/wxs_panl.cxx : $(srcdir)/wxs_panl.xc $(srcdir)/wxs_panl.xci $(srcdir)/wxs_fram.xci $(srcdir)/wxs_cnvs.xci $(srcdir)/wxs_dorf.xci \
@ -206,10 +195,6 @@ $(srcdir)/wxs_rado.cxx : $(srcdir)/wxs_rado.xc $(srcdir)/range.xci $(XCDEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_rado.cxx ; else $(XCTOCXX) $(srcdir)/wxs_rado.xc ; fi
$(srcdir)/wxs_slid.cxx : $(srcdir)/wxs_slid.xc $(XCDEPEND) $(CB_DEPEND) $(ITEM_DEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_slid.cxx ; else $(XCTOCXX) $(srcdir)/wxs_slid.xc ; fi
$(srcdir)/wxs_snip.cxx : $(srcdir)/wxs_snip.xc $(srcdir)/wxs_snip.xci $(srcdir)/wxs_bmt.xci $(srcdir)/wxs_cret.xci $(srcdir)/wxs_eop.xci $(XCDEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_snip.cxx ; else $(XCTOCXX) $(srcdir)/wxs_snip.xc ; fi
$(srcdir)/wxs_styl.cxx : $(srcdir)/wxs_styl.xc $(XCDEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_styl.cxx ; else $(XCTOCXX) $(srcdir)/wxs_styl.xc ; fi
$(srcdir)/wxs_tabc.cxx : $(srcdir)/wxs_tabc.xc $(srcdir)/range.xci $(srcdir)/wxs_item.xci $(LIST_DEPEND) $(CB_DEPEND) $(XCDEPEND)
if [ "$(PERL)" = '' ] ; then touch $(srcdir)/wxs_tabc.cxx ; else $(XCTOCXX) $(srcdir)/wxs_tabc.xc ; fi
$(srcdir)/wxs_win.cxx : $(srcdir)/wxs_win.xc $(srcdir)/wxs_win.xci $(XCDEPEND)
@ -217,7 +202,7 @@ $(srcdir)/wxs_win.cxx : $(srcdir)/wxs_win.xc $(srcdir)/wxs_win.xci $(XCDEPEND)
WXSCC = $(CXX) @USE_WXPRECOMP@ $(WXSCXXFLAGS) $(CXXDEPFLAGS) $(LOCALFLAGS) -c
wxscheme.@LTO@ : $(srcdir)/wxscheme.cxx $(WXSCHEMEHEADERS) $(MEDIAHEADERS) $(DCHEADERS) $(srcdir)/wxsmred.h
wxscheme.@LTO@ : $(srcdir)/wxscheme.cxx $(WXSCHEMEHEADERS) $(DCHEADERS) $(srcdir)/wxsmred.h
$(WXSCC) $(srcdir)/wxscheme.cxx -o wxscheme.@LTO@
xcglue.@LTO@ : $(srcdir)/../../mzscheme/utils/xcglue.c $(srcdir)/../../mzscheme/utils/xcglue.h $(WXSCHEMEHEADERS)
@ -249,20 +234,10 @@ wxs_item.@LTO@ : $(srcdir)/wxs_item.cxx $(WXSCHEMEHEADERS) $(WINDOWHEADERS)
$(WXSCC) $(srcdir)/wxs_item.cxx -o wxs_item.@LTO@
wxs_lbox.@LTO@ : $(srcdir)/wxs_lbox.cxx $(WXSCHEMEHEADERS) $(WINDOWHEADERS) $(LISTBOXHEADER)
$(WXSCC) $(srcdir)/wxs_lbox.cxx -o wxs_lbox.@LTO@
wxs_madm.@LTO@ : $(srcdir)/wxs_madm.cxx $(WXSCHEMEHEADERS) $(MEDIAHEADERS) $(WINDOWHEADERS) $(MAINDCHEADERS)
$(WXSCC) $(srcdir)/wxs_madm.cxx -o wxs_madm.@LTO@
wxs_medi.@LTO@ : $(srcdir)/wxs_medi.cxx $(WXSCHEMEHEADERS) $(MEDIAHEADERS) $(WINDOWHEADERS) $(MAINDCHEADERS)
$(WXSCC) $(srcdir)/wxs_medi.cxx -o wxs_medi.@LTO@
wxs_mede.@LTO@ : $(srcdir)/wxs_mede.cxx $(WXSCHEMEHEADERS) $(MEDIAHEADERS) $(WINDOWHEADERS) $(MAINDCHEADERS)
$(WXSCC) $(srcdir)/wxs_mede.cxx -o wxs_mede.@LTO@
wxs_menu.@LTO@ : $(srcdir)/wxs_menu.cxx $(WXSCHEMEHEADERS) $(WINDOWHEADERS)
$(WXSCC) $(srcdir)/wxs_menu.cxx -o wxs_menu.@LTO@
wxs_mio.@LTO@ : $(srcdir)/wxs_mio.cxx $(WXSCHEMEHEADERS) $(MEDIAHEADERS) $(WINDOWHEADERS)
$(WXSCC) $(srcdir)/wxs_mio.cxx -o wxs_mio.@LTO@
wxs_misc.@LTO@ : $(srcdir)/wxs_misc.cxx $(WXSCHEMEHEADERS) $(WINDOWHEADERS) $(CLIPBHEADER)
$(WXSCC) $(srcdir)/wxs_misc.cxx -o wxs_misc.@LTO@
wxs_mpb.@LTO@ : $(srcdir)/wxs_mpb.cxx $(WXSCHEMEHEADERS) $(MEDIAHEADERS) $(WINDOWHEADERS) $(srcdir)/../wxme/wx_medpb.h $(MAINDCHEADERS)
$(WXSCC) $(srcdir)/wxs_mpb.cxx -o wxs_mpb.@LTO@
wxs_obj.@LTO@ : $(srcdir)/wxs_obj.cxx $(WXSCHEMEHEADERS)
$(WXSCC) $(srcdir)/wxs_obj.cxx -o wxs_obj.@LTO@
wxs_panl.@LTO@ : $(srcdir)/wxs_panl.cxx $(WXSCHEMEHEADERS) $(WINDOWHEADERS)
@ -271,10 +246,6 @@ wxs_rado.@LTO@ : $(srcdir)/wxs_rado.cxx $(WXSCHEMEHEADERS) $(WINDOWHEADERS)
$(WXSCC) $(srcdir)/wxs_rado.cxx -o wxs_rado.@LTO@
wxs_slid.@LTO@ : $(srcdir)/wxs_slid.cxx $(WXSCHEMEHEADERS) $(WINDOWHEADERS)
$(WXSCC) $(srcdir)/wxs_slid.cxx -o wxs_slid.@LTO@
wxs_snip.@LTO@ : $(srcdir)/wxs_snip.cxx $(WXSCHEMEHEADERS) $(MEDIAHEADERS) $(WINDOWHEADERS) $(MAINDCHEADERS)
$(WXSCC) $(srcdir)/wxs_snip.cxx -o wxs_snip.@LTO@
wxs_styl.@LTO@ : $(srcdir)/wxs_styl.cxx $(WXSCHEMEHEADERS) $(WINDOWHEADERS) $(srcdir)/../wxme/wx_style.h $(MAINDCHEADERS)
$(WXSCC) $(srcdir)/wxs_styl.cxx -o wxs_styl.@LTO@
wxs_tabc.@LTO@ : $(srcdir)/wxs_tabc.cxx $(WXSCHEMEHEADERS) $(TABCDOWHEADERS)
$(WXSCC) $(srcdir)/wxs_tabc.cxx -o wxs_tabc.@LTO@
wxs_win.@LTO@ : $(srcdir)/wxs_win.cxx $(WXSCHEMEHEADERS) $(WINDOWHEADERS)
@ -293,19 +264,12 @@ $(srcdir)/wxs_gdi.ss : $(srcdir)/wxs_gdi.cxx
$(srcdir)/wxs_glob.ss : $(srcdir)/wxs_glob.cxx
$(srcdir)/wxs_item.ss : $(srcdir)/wxs_item.cxx
$(srcdir)/wxs_lbox.ss : $(srcdir)/wxs_lbox.cxx
$(srcdir)/wxs_madm.ss : $(srcdir)/wxs_madm.cxx
$(srcdir)/wxs_mede.ss : $(srcdir)/wxs_mede.cxx
$(srcdir)/wxs_medi.ss : $(srcdir)/wxs_medi.cxx
$(srcdir)/wxs_menu.ss : $(srcdir)/wxs_menu.cxx
$(srcdir)/wxs_mio.ss : $(srcdir)/wxs_mio.cxx
$(srcdir)/wxs_misc.ss : $(srcdir)/wxs_misc.cxx
$(srcdir)/wxs_mpb.ss : $(srcdir)/wxs_mpb.cxx
$(srcdir)/wxs_obj.ss : $(srcdir)/wxs_obj.cxx
$(srcdir)/wxs_panl.ss : $(srcdir)/wxs_panl.cxx
$(srcdir)/wxs_rado.ss : $(srcdir)/wxs_rado.cxx
$(srcdir)/wxs_slid.ss : $(srcdir)/wxs_slid.cxx
$(srcdir)/wxs_snip.ss : $(srcdir)/wxs_snip.cxx
$(srcdir)/wxs_styl.ss : $(srcdir)/wxs_styl.cxx
$(srcdir)/wxs_tabc.ss : $(srcdir)/wxs_tabc.cxx
$(srcdir)/wxs_win.ss : $(srcdir)/wxs_win.cxx
@ -323,19 +287,12 @@ $(srcdir)/wxs_win.ss : $(srcdir)/wxs_win.cxx
@INCLUDEDEP@ wxs_glob.d
@INCLUDEDEP@ wxs_item.d
@INCLUDEDEP@ wxs_lbox.d
@INCLUDEDEP@ wxs_madm.d
@INCLUDEDEP@ wxs_mede.d
@INCLUDEDEP@ wxs_medi.d
@INCLUDEDEP@ wxs_menu.d
@INCLUDEDEP@ wxs_mio.d
@INCLUDEDEP@ wxs_misc.d
@INCLUDEDEP@ wxs_mpb.d
@INCLUDEDEP@ wxs_obj.d
@INCLUDEDEP@ wxs_panl.d
@INCLUDEDEP@ wxs_rado.d
@INCLUDEDEP@ wxs_slid.d
@INCLUDEDEP@ wxs_snip.d
@INCLUDEDEP@ wxs_styl.d
@INCLUDEDEP@ wxs_tabc.d
@INCLUDEDEP@ wxs_win.d
@INCLUDEDEP@ wxscheme.d

12
src/mred/wxs/ktail.ss
View File

@ -3,7 +3,6 @@
(define-functions
special-control-key
special-option-key
map-command-as-meta-key
application-file-handler
application-quit-handler
application-about-handler
@ -28,20 +27,19 @@
shortcut-visible-in-label?
eventspace-shutdown?
in-atomic-region
set-editor-snip-maker
set-text-editor-maker
set-pasteboard-editor-maker
set-menu-tester
location->window
set-dialogs
set-executer
send-event
file-creator-and-type
set-snip-class-getter
set-editor-data-class-getter
set-ps-procs
main-eventspace?
eventspace-handler-thread)
eventspace-handler-thread
begin-refresh-sequence
end-refresh-sequence
run-printout
get-double-click-time)
)
;; end

7
src/mred/wxs/wxs_cret.xci
View File

@ -1,7 +0,0 @@
@BEGINSYMBOLS caret > ONE > PRED
@SYM "no-caret" : wxSNIP_DRAW_NO_CARET
@SYM "show-caret" : wxSNIP_DRAW_SHOW_CARET
@SYM "show-inactive-caret" : wxSNIP_DRAW_SHOW_INACTIVE_CARET
@ENDSYMBOLS

25
src/mred/wxs/wxs_dc.cxx
View File

@ -1123,6 +1123,7 @@ static l_TYPE l_POINT *l_MAKE_ARRAY(Scheme_Object *l, l_INTTYPE *c, char *who)
class os_wxDC : public wxDC {
public:
@ -1150,6 +1151,27 @@ os_wxDC::~os_wxDC()
objscheme_destroy(this, (Scheme_Object *) __gc_external);
}
static Scheme_Object *os_wxDCCacheFontMetricsKey(int n, Scheme_Object *p[])
{
WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
REMEMBER_VAR_STACK();
int r;
objscheme_check_valid(os_wxDC_class, "cache-font-metrics-key in dc<%>", n, p);
SETUP_VAR_STACK_REMEMBERED(1);
VAR_STACK_PUSH(0, p);
r = WITH_VAR_STACK(((wxDC *)((Scheme_Class_Object *)p[0])->primdata)->CacheFontMetricsKey());
READY_TO_RETURN;
return scheme_make_integer(r);
}
static Scheme_Object *os_wxDCGetAlpha(int n, Scheme_Object *p[])
{
WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
@ -2572,8 +2594,9 @@ void objscheme_setup_wxDC(Scheme_Env *env)
wxREGGLOB(os_wxDC_class);
wxREGGLOB(os_wxDC_interface);
os_wxDC_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "dc%", "object%", NULL, 51));
os_wxDC_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "dc%", "object%", NULL, 52));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxDC_class, "cache-font-metrics-key" " method", (Scheme_Method_Prim *)os_wxDCCacheFontMetricsKey, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxDC_class, "get-alpha" " method", (Scheme_Method_Prim *)os_wxDCGetAlpha, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxDC_class, "set-alpha" " method", (Scheme_Method_Prim *)os_wxDCSetAlpha, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxDC_class, "glyph-exists?" " method", (Scheme_Method_Prim *)os_wxDCGlyphAvailable, 1, 2));

Some files were not shown because too many files have changed in this diff Show More