.
original commit: bdf5291eb92dca83329a357db68f712a80993af7
This commit is contained in:
parent
f041b7e137
commit
ad5e0e4195
|
@ -575,7 +575,9 @@
|
|||
(send (get-dc) set-origin 0 0)
|
||||
|
||||
(let ([dc (if ps?
|
||||
(let ([dc (make-object post-script-dc%)])
|
||||
(let ([dc (if (eq? ps? 'print)
|
||||
(make-object printer-dc%)
|
||||
(make-object post-script-dc%))])
|
||||
(and (send dc ok?) dc))
|
||||
(if (and use-bitmap?)
|
||||
(begin
|
||||
|
@ -701,9 +703,12 @@
|
|||
(set! use-bad? (< 2 (send self get-selection)))
|
||||
(send canvas on-paint))
|
||||
'(horizontal))
|
||||
(make-object button% "PostScript" hp
|
||||
(make-object button% "PS" hp
|
||||
(lambda (self event)
|
||||
(send canvas on-paint #t)))
|
||||
(make-object button% "Print" hp
|
||||
(lambda (self event)
|
||||
(send canvas on-paint 'print)))
|
||||
(make-object check-box% "*2" hp
|
||||
(lambda (self event)
|
||||
(send canvas set-scale (if (send self get-value) 2 1))))
|
||||
|
|
|
@ -2,6 +2,21 @@
|
|||
(when (not (defined? 'test))
|
||||
(load-relative "testing.ss"))
|
||||
|
||||
; These message boxes mustn't survive
|
||||
(let ([c (make-custodian)])
|
||||
(parameterize ([current-custodian c])
|
||||
(parameterize ([current-eventspace (make-eventspace)])
|
||||
(queue-callback
|
||||
(lambda ()
|
||||
(queue-callback
|
||||
(lambda ()
|
||||
(sleep/yield 0.1)
|
||||
(queue-callback
|
||||
(lambda ()
|
||||
(custodian-shutdown-all c)))
|
||||
(message-box "w" "q")))
|
||||
(message-box "x" "y"))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Windowing Tests ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
Loading…
Reference in New Issue
Block a user