original commit: 1b72c54d45dcf763b0508c2759ab6be4533f6bb9
This commit is contained in:
Matthew Flatt 2005-03-13 15:16:19 +00:00
parent 4cdc36eaae
commit 849da7c82b
4 changed files with 30 additions and 2 deletions

View File

@ -25,6 +25,7 @@
brush%
brush-list%
button%
can-get-page-setup-from-user?
canvas%
canvas<%>
check-box%
@ -89,6 +90,7 @@
get-file
get-file-list
get-font-from-user
get-page-setup-from-user
get-panel-background
get-ps-setup-from-user
get-resource

View File

@ -239,6 +239,8 @@
get-choices-from-user
get-text-from-user
get-ps-setup-from-user
get-page-setup-from-user
can-get-page-setup-from-user?
play-sound
get-display-size
get-display-left-top-inset

View File

@ -1008,8 +1008,6 @@
get-data
on-replaced)
(define-class ps-setup% object% ()
show-native
can-show-native?
copy-from
set-margin
set-editor-margin
@ -1033,6 +1031,8 @@
get-preview-command
get-file
get-command)
(define-function show-print-setup)
(define-function can-show-print-setup?)
(define-class pasteboard% editor% #f
set-scroll-step
get-scroll-step

View File

@ -19,6 +19,8 @@
"mrtextfield.ss")
(provide get-ps-setup-from-user
get-page-setup-from-user
can-get-page-setup-from-user?
get-text-from-user
get-choices-from-user
get-color-from-user)
@ -139,6 +141,28 @@
s)
#f)]))
(define get-page-setup-from-user
(case-lambda
[() (get-page-setup-from-user #f #f #f null)]
[(message) (get-page-setup-from-user message #f #f null)]
[(message parent) (get-page-setup-from-user message parent #f null)]
[(message parent pss) (get-page-setup-from-user message parent pss null)]
[(message parent pss-in style)
(check-label-string/false 'get-page-setup-from-user message)
(check-top-level-parent/false 'get-page-setup-from-user parent)
(check-instance 'get-page-setup-from-user wx:ps-setup% 'ps-setup% #t pss-in)
(check-style 'get-page-setup-from-user #f null style)
(and (wx:can-show-print-setup?)
(let ([s (make-object wx:ps-setup%)])
(send s copy-from (or pss-in (wx:current-ps-setup)))
(and (parameterize ([wx:current-ps-setup s])
(wx:show-print-setup parent))
s)))]))
(define (can-get-page-setup-from-user?)
(wx:can-show-print-setup?))
(define get-text-from-user
(case-lambda
[(title message) (get-text-from-user title message #f "" null)]