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

Change a bunch of "~%" and "~n" in format strings to "\n".

Browse Source 
original commit: 7dc4d2e5a63ab416d90e44d7bf75cb5593329909
This commit is contained in:
Eli Barzilay 2010-08-25 17:16:32 -04:00
parent b0135206c3
commit 2c1b48d3c4
11 changed files with 99 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/framework/preferences.rkt
View File

@ -244,7 +244,7 @@ the state transitions / contracts are:
(pref-can-init? p))
(let ([default-okay? (checker default-value)])
(unless default-okay?
(error 'set-default "~s: checker (~s) returns ~s for ~s, expected #t~n"
(error 'set-default "~s: checker (~s) returns ~s for ~s, expected #t\n"
p checker default-okay? default-value)))
(unless (= (length aliases) (length rewrite-aliases))

6
collects/framework/private/color-model.rkt
View File

@ -192,7 +192,7 @@
(,(xyz-z xyz-white))))])
(apply values (car (transpose sigmas)))))
;; (printf "should be equal to xyz-white: ~n~a~n"
;; (printf "should be equal to xyz-white: \n~a\n"
;; (matrix-multiply pre-matrix `((,sigma-r) (,sigma-g) (,sigma-b))))
(define rgb->xyz-matrix
@ -203,13 +203,13 @@
(define xyz->rgb-matrix
(matrix-invert rgb->xyz-matrix))
;;(printf "should be identity: ~n~a~n" (matrix-multiply rgb->xyz-matrix xyz->rgb-matrix))
;;(printf "should be identity: \n~a\n" (matrix-multiply rgb->xyz-matrix xyz->rgb-matrix))
(define (rgb->xyz r g b)
(apply make-xyz (car (transpose (matrix-multiply rgb->xyz-matrix (transpose `((,r ,g ,b))))))))
;;(print-struct #t)
;; (printf "should be xyz-white: ~n~a~n" (rgb->xyz 255 255 255))
;; (printf "should be xyz-white: \n~a\n" (rgb->xyz 255 255 255))
(define (xyz->rgb x y z)
(car (transpose (matrix-multiply xyz->rgb-matrix (transpose `((,x ,y ,z)))))))

40
collects/framework/private/color.rkt
View File

@ -286,7 +286,7 @@ added get-regions
(enable-suspend #t)))])
(unless (eq? 'eof type)
(enable-suspend #f)
#; (printf "~a at ~a to ~a~n" lexeme (+ in-start-pos (sub1 new-token-start))
#; (printf "~a at ~a to ~a\n" lexeme (+ in-start-pos (sub1 new-token-start))
(+ in-start-pos (sub1 new-token-end)))
(let ((len (- new-token-end new-token-start)))
(set-lexer-state-current-pos! ls (+ len (lexer-state-current-pos ls)))
@ -418,11 +418,11 @@ added get-regions
(define/private (colorer-driver)
(unless (andmap lexer-state-up-to-date? lexer-states)
#;(printf "revision ~a~n" (get-revision-number))
#;(printf "revision ~a\n" (get-revision-number))
(unless (and tok-cor (= rev (get-revision-number)))
(when tok-cor
(coroutine-kill tok-cor))
#;(printf "new coroutine~n")
#;(printf "new coroutine\n")
(set! tok-cor
(coroutine
(λ (enable-suspend)
@ -450,19 +450,19 @@ added get-regions
(format "exception in colorer thread: ~s" exn)
exn))
(set! tok-cor #f))))
#;(printf "begin lexing~n")
#;(printf "begin lexing\n")
(when (coroutine-run 10 tok-cor)
(for-each (lambda (ls)
(set-lexer-state-up-to-date?! ls #t))
lexer-states)))
#;(printf "end lexing~n")
#;(printf "begin coloring~n")
#;(printf "end lexing\n")
#;(printf "begin coloring\n")
;; This edit sequence needs to happen even when colors is null
;; for the paren highlighter.
(begin-edit-sequence #f #f)
(color)
(end-edit-sequence)
#;(printf "end coloring~n")))
#;(printf "end coloring\n")))
(define/private (colorer-callback)
(cond
@ -643,7 +643,7 @@ added get-regions
;; possible.
(define/private match-parens
(lambda ([just-clear? #f])
;;(printf "(match-parens ~a)~n" just-clear?)
;;(printf "(match-parens ~a)\n" just-clear?)
(when (and (not in-match-parens?)
;; Trying to match open parens while the
;; background thread is going slows it down.
@ -918,21 +918,21 @@ added get-regions
(let* ((x null)
(f (λ (a b c) (set! x (cons (list a b c) x)))))
(send (lexer-state-tokens ls) for-each f)
(printf "tokens: ~.s~n" (reverse x))
(printf "tokens: ~.s\n" (reverse x))
(set! x null)
(send (lexer-state-invalid-tokens ls) for-each f)
(printf "invalid-tokens: ~.s~n" (reverse x))
(printf "start-pos: ~a current-pos: ~a invalid-tokens-start ~a~n"
(printf "invalid-tokens: ~.s\n" (reverse x))
(printf "start-pos: ~a current-pos: ~a invalid-tokens-start ~a\n"
(lexer-state-start-pos ls)
(lexer-state-current-pos ls)
(lexer-state-invalid-tokens-start ls))
(printf "parens: ~.s~n" (car (send (lexer-state-parens ls) test)))))
(printf "parens: ~.s\n" (car (send (lexer-state-parens ls) test)))))
lexer-states))
;; ------------------------- Callbacks to Override ----------------------
(define/override (lock x)
;;(printf "(lock ~a)~n" x)
;;(printf "(lock ~a)\n" x)
(super lock x)
(when (and restart-callback (not x))
(set! restart-callback #f)
@ -940,25 +940,25 @@ added get-regions
(define/override (on-focus on?)
;;(printf "(on-focus ~a)~n" on?)
;;(printf "(on-focus ~a)\n" on?)
(super on-focus on?)
(match-parens (not on?)))
(define/augment (after-edit-sequence)
;;(printf "(after-edit-sequence)~n")
;;(printf "(after-edit-sequence)\n")
(when (has-focus?)
(match-parens))
(inner (void) after-edit-sequence))
(define/augment (after-set-position)
;;(printf "(after-set-position)~n")
;;(printf "(after-set-position)\n")
(unless (local-edit-sequence?)
(when (has-focus?)
(match-parens)))
(inner (void) after-set-position))
(define/augment (after-change-style a b)
;;(printf "(after-change-style)~n")
;;(printf "(after-change-style)\n")
(unless (get-styles-fixed)
(unless (local-edit-sequence?)
(when (has-focus?)
@ -966,19 +966,19 @@ added get-regions
(inner (void) after-change-style a b))
(define/augment (on-set-size-constraint)
;;(printf "(on-set-size-constraint)~n")
;;(printf "(on-set-size-constraint)\n")
(unless (local-edit-sequence?)
(when (has-focus?)
(match-parens)))
(inner (void) on-set-size-constraint))
(define/augment (after-insert edit-start-pos change-length)
;;(printf "(after-insert ~a ~a)~n" edit-start-pos change-length)
;;(printf "(after-insert ~a ~a)\n" edit-start-pos change-length)
(do-insert/delete edit-start-pos change-length)
(inner (void) after-insert edit-start-pos change-length))
(define/augment (after-delete edit-start-pos change-length)
;;(printf "(after-delete ~a ~a)~n" edit-start-pos change-length)
;;(printf "(after-delete ~a ~a)\n" edit-start-pos change-length)
(do-insert/delete edit-start-pos (- change-length))
(inner (void) after-delete edit-start-pos change-length))

4
collects/framework/private/editor.rkt
View File

@ -242,10 +242,10 @@
(unless (and (procedure? t)
(= 0 (procedure-arity t)))
(error 'editor:basic::run-after-edit-sequence
"expected procedure of arity zero, got: ~s~n" t))
"expected procedure of arity zero, got: ~s\n" t))
(unless (or (symbol? sym) (not sym))
(error 'editor:basic::run-after-edit-sequence
"expected second argument to be a symbol or #f, got: ~s~n"
"expected second argument to be a symbol or #f, got: ~s\n"
sym))
(if (refresh-delayed?)
(if in-local-edit-sequence?

4
collects/framework/private/gen-standard-menus.rkt
View File

@ -125,7 +125,7 @@
(write-docs))
(define (write-docs)
(printf "writing to ~a~n" docs-menus.ss-filename)
(printf "writing to ~a\n" docs-menus.ss-filename)
(call-with-output-file docs-menus.ss-filename
(λ (port)
(define (pop-out sexp)
@ -203,7 +203,7 @@
#:exists 'truncate))
(define (write-standard-menus.rkt)
(printf "writing to ~a~n" standard-menus.rkt-filename)
(printf "writing to ~a\n" standard-menus.rkt-filename)
(call-with-output-file standard-menus.rkt-filename
(λ (port)

2
collects/framework/private/panel.rkt
View File

@ -44,7 +44,7 @@
[(left top) 0]
[(right bottom) (- total-size item-size)]
[else (error 'place-children
"alignment spec is unknown ~a~n" spec)])))])
"alignment spec is unknown ~a\n" spec)])))])
(map (λ (l)
(let*-values ([(min-width min-height h-stretch? v-stretch?)
(apply values l)]

2
collects/framework/private/preferences.rkt
View File

@ -528,7 +528,7 @@ the state transitions / contracts are:
(cond
[(string? default) string?]
[(number? default) number?]
[else (error 'internal-error.set-default "unrecognized default: ~a~n" default)]))
[else (error 'internal-error.set-default "unrecognized default: ~a\n" default)]))
(preferences:add-callback
name
(λ (p new-value)

4
collects/framework/splash.rkt
View File

@ -123,12 +123,12 @@
[(or (path? splash-draw-spec)
(string? splash-draw-spec))
(unless (file-exists? splash-draw-spec)
(fprintf (current-error-port) "WARNING: bitmap path ~s not found~n" splash-draw-spec)
(fprintf (current-error-port) "WARNING: bitmap path ~s not found\n" splash-draw-spec)
(no-splash))
(set! splash-bitmap (make-object bitmap% splash-draw-spec))
(unless (send splash-bitmap ok?)
(fprintf (current-error-port) "WARNING: bad bitmap ~s~n" splash-draw-spec)
(fprintf (current-error-port) "WARNING: bad bitmap ~s\n" splash-draw-spec)
(no-splash))
(send splash-canvas min-width (send splash-bitmap get-width))

2
collects/framework/test.rkt
View File

@ -363,7 +363,7 @@
(loop (- n 1))))])))]
[(number? state)
(unless (send rb is-enabled? state)
(error 'test:set-radio-box! "item ~a is not enabled~n" state))
(error 'test:set-radio-box! "item ~a is not enabled\n" state))
(send rb set-selection state)]
[else (error 'test:set-radio-box!
"expected a string or a number as second arg, got: ~e (other arg: ~e)"

64
collects/tests/gracket/item.rkt
View File

@ -133,7 +133,7 @@
(if (not l)
win
l)))])
(when noisy? (printf "~a~n" s))
(when noisy? (printf "~a\n" s))
(send m set-label (substring s 0 (min 200 (string-length s))))))))
(define (add-click-intercept frame panel)
@ -146,7 +146,7 @@
(make-object menu-item% (format "Click on ~a" win)
m (lambda (i e)
(unless (eq? (send m get-popup-target) win)
(printf "Wrong owner!~n"))))
(printf "Wrong owner!\n"))))
(send win popup-menu m
(inexact->exact (send e get-x))
(inexact->exact (send e get-y)))
@ -160,7 +160,7 @@
[cc (make-object cursor% 'cross)])
(make-object check-box% "Control Bullseye Cursors" panel
(lambda (c e)
(printf "~a~n" e)
(printf "~a\n" e)
(if (send c get-value)
(set! old
(map (lambda (b)
@ -200,7 +200,7 @@
(override
[on-demand
(lambda ()
(printf "Menu item ~a demanded~n" name))])
(printf "Menu item ~a demanded\n" name))])
(sequence
(apply super-init name args))))
@ -239,7 +239,7 @@
(memq (send e get-event-type)
'(menu-popdown menu-popdown-none)))
(error "bad event object"))
(printf "popdown ok~n")))]
(printf "popdown ok\n")))]
[make-callback
(let ([id 0])
(lambda ()
@ -297,7 +297,7 @@
(sequence
(apply super-init args)
(unless (ok?)
(printf "bitmap failure: ~s~n" args)))))
(printf "bitmap failure: ~s\n" args)))))
(define (active-mixin %)
(class %
@ -312,9 +312,9 @@
[on-subwindow-char (lambda args
(or (apply pre-on args)
(super on-subwindow-char . args)))]
[on-activate (lambda (on?) (printf "active: ~a~n" on?))]
[on-move (lambda (x y) (printf "moved: ~a ~a~n" x y))]
[on-size (lambda (x y) (printf "sized: ~a ~a~n" x y))])
[on-activate (lambda (on?) (printf "active: ~a\n" on?))]
[on-move (lambda (x y) (printf "moved: ~a ~a\n" x y))]
[on-size (lambda (x y) (printf "sized: ~a ~a\n" x y))])
(public* [set-info
(lambda (ep)
(set! pre-on (add-pre-note this ep))
@ -331,10 +331,10 @@
(override
[on-superwindow-show
(lambda (on?)
(printf "~a ~a~n" name (if on? "show" "hide")))]
(printf "~a ~a\n" name (if on? "show" "hide")))]
[on-superwindow-enable
(lambda (on?)
(printf "~a ~a~n" name (if on? "on" "off")))])
(printf "~a ~a\n" name (if on? "on" "off")))])
(sequence
(apply super-init name args))))
@ -952,7 +952,7 @@
(compare expect v (format "label search: ~a" string))))]
[tell-ok
(lambda ()
(printf "ok~n"))])
(printf "ok\n"))])
(private-field
[temp-labels? #f]
[use-menubar? #f]
@ -1180,7 +1180,7 @@
(unless (memq type types)
(error (format "bad event type: ~a" type))))
(unless silent?
(printf "Callback Ok~n")))
(printf "Callback Ok\n")))
(define (instructions v-panel file)
(define c (make-object editor-canvas% v-panel))
@ -1216,7 +1216,7 @@
(lambda (e)
(check-callback-event b b e commands #t))
old-list)
(printf "All Ok~n"))))
(printf "All Ok\n"))))
(define e (make-object button%
"Disable Test" p
(lambda (c e)
@ -1227,7 +1227,7 @@
(thread (lambda () (sleep 0.5) (semaphore-post sema)))
(yield sema)
(when hit?
(printf "un-oh~n"))
(printf "un-oh\n"))
(send b enable #t)))))
(instructions p "button-steps.txt")
(send f show #t))
@ -1261,7 +1261,7 @@
(lambda (e)
(check-callback-event cb cb e commands #t))
old-list)
(printf "All Ok~n"))))
(printf "All Ok\n"))))
(instructions p "checkbox-steps.txt")
(send f show #t))
@ -1333,7 +1333,7 @@
(lambda (rbe)
(check-callback-event (car rbe) (car rbe) (cdr rbe) commands #t))
old-list)
(printf "All Ok~n")))
(printf "All Ok\n")))
(instructions p "radiobox-steps.txt")
(send f show #t))
@ -1360,12 +1360,12 @@
(cond
[(eq? (send e get-event-type) 'list-box-dclick)
; double-click
(printf "Double-click~n")
(printf "Double-click\n")
(unless (send cx get-selection)
(error "no selection for dclick"))]
[else
; misc multi-selection
(printf "Changed: ~a~n" (if list?
(printf "Changed: ~a\n" (if list?
(send cx get-selections)
(send cx get-selection)))])
(check-callback-event c cx e commands #f)))
@ -1402,7 +1402,7 @@
(make-object button%
"Visible Indices" p
(lambda (b e)
(printf "top: ~a~nvisible count: ~a~n"
(printf "top: ~a\nvisible count: ~a\n"
(send c get-first-visible-item)
(send c number-of-visible-items))))))
(define cdp (make-object horizontal-panel% p))
@ -1555,9 +1555,9 @@
(lambda (e)
(check-callback-event c c e commands #t))
old-list)
(printf "content: ~s~n" actual-content)
(printf "content: ~s\n" actual-content)
(when multi?
(printf "selections: ~s~n" (send c get-selections))))))
(printf "selections: ~s\n" (send c get-selections))))))
(send c stretchable-width #t)
(instructions p "choice-list-steps.txt")
(send f show #t))
@ -1570,7 +1570,7 @@
(define s (make-object slider% "Slide Me" -1 11 p
(lambda (sl e)
(check-callback-event s sl e commands #f)
(printf "slid: ~a~n" (send s get-value)))
(printf "slid: ~a\n" (send s get-value)))
3))
(define c (make-object button% "Check" p
(lambda (c e)
@ -1578,7 +1578,7 @@
(lambda (e)
(check-callback-event s s e commands #t))
old-list)
(printf "All Ok~n"))))
(printf "All Ok\n"))))
(define (simulate v)
(let ([e (make-object control-event% 'slider)])
(send s set-value v)
@ -1634,13 +1634,13 @@
(define (handler get-this)
(lambda (c e)
(unless (eq? c (get-this))
(printf "callback: bad item: ~a~n" c))
(printf "callback: bad item: ~a\n" c))
(let ([t (send e get-event-type)])
(cond
[(eq? t 'text-field)
(printf "Changed: ~a~n" (send c get-value))]
(printf "Changed: ~a\n" (send c get-value))]
[(eq? t 'text-field-enter)
(printf "Return: ~a~n" (send c get-value))]))))
(printf "Return: ~a\n" (send c get-value))]))))
(define f (make-frame frame% "Text Test"))
(define p (make-object vertical-panel% f))
@ -1701,7 +1701,7 @@
(send f set-status-text s)))]
[on-scroll
(lambda (e)
(when auto? (printf "Hey - on-scroll called for auto scrollbars~n"))
(when auto? (printf "Hey - on-scroll called for auto scrollbars\n"))
(unless incremental? (on-paint)))]
[init-auto-scrollbars (lambda x
(set! auto? #t)
@ -1877,7 +1877,7 @@
(let ([c (car (send p get-children))])
(let-values ([(w h) (send c get-size)]
[(cw ch) (send c get-client-size)])
(printf "~a: (~a x ~a) client[~a x ~a] diff<~a x ~a> min{~a x ~a}~n"
(printf "~a: (~a x ~a) client[~a x ~a] diff<~a x ~a> min{~a x ~a}\n"
c w h cw ch
(- w cw) (- h ch)
(send c min-width) (send c min-height)))))
@ -1962,7 +1962,7 @@
(make-object button% "Rename" p2 (lambda (b e)
(send p set-item-label (quotient (send p get-number) 2) "Do&nut")))
(make-object button% "Labels" p2 (lambda (b e)
(printf "~s~n"
(printf "~s\n"
(reverse
(let loop ([i (send p get-number)])
(if (zero? i)
@ -2000,10 +2000,10 @@
(define (message-boxes parent)
(define (check expected got)
(unless (eq? expected got)
(fprintf (current-error-port) "bad result: - expected ~e, got ~e~n"
(fprintf (current-error-port) "bad result: - expected ~e, got ~e\n"
expected got)))
(define (big s)
(format "~a~n~a~n~a~n~a~n" s
(format "~a\n~a\n~a\n~a\n" s
(make-string 500 #\x)
(make-string 500 #\x)
(make-string 500 #\x)))

68
collects/tests/gracket/windowing.rktl
View File

@ -39,7 +39,7 @@
(test (list s) 'yield-wrapped (yield (wrap-evt s (lambda (v) (list v))))))
(define (enable-tests f)
(printf "Enable ~a~n" f)
(printf "Enable ~a\n" f)
(st #t f is-enabled?)
(stv f enable #f)
(st #f f is-enabled?)
@ -47,7 +47,7 @@
(st #t f is-enabled?))
(define (drop-file-tests f)
(printf "Drop File ~a~n" f)
(printf "Drop File ~a\n" f)
(st #f f accept-drop-files)
(stv f accept-drop-files #t)
(st #t f accept-drop-files)
@ -55,7 +55,7 @@
(st #f f accept-drop-files))
(define (client->screen-tests f)
(printf "Client<->Screen ~a~n" f)
(printf "Client<->Screen ~a\n" f)
(let-values ([(x y) (send f client->screen 0 0)])
(stvals '(0 0) f screen->client x y))
(let-values ([(x y) (send f screen->client 0 0)])
@ -66,7 +66,7 @@
(stv f refresh))
(define (area-tests f sw? sh? no-stretch?)
(printf "Area ~a~n" f)
(printf "Area ~a\n" f)
(let ([x (send f min-width)]
[y (send f min-height)])
(st sw? f stretchable-width)
@ -76,7 +76,7 @@
(let-values ([(w h) (if no-stretch?
(send f get-size)
(values 0 0))])
(printf "Size ~a x ~a~n" w h)
(printf "Size ~a x ~a\n" w h)
(when no-stretch?
(stv f min-width w) ; when we turn of stretchability, don't resize
(stv f min-height h))
@ -95,7 +95,7 @@
(define (containee-tests f sw? sh? m)
(area-tests f sw? sh? #f)
(printf "Containee ~a~n" f)
(printf "Containee ~a\n" f)
(st m f horiz-margin)
(st m f vert-margin)
(stv f horiz-margin 3)
@ -108,14 +108,14 @@
(stv f vert-margin m))
(define (container-tests f win?)
(printf "Container ~a~n" f)
(printf "Container ~a\n" f)
(let-values ([(x y) (send f get-alignment)])
(stv f set-alignment 'right 'bottom)
(stvals '(right bottom) f get-alignment)
(stv f set-alignment x y)))
(define (cursor-tests f)
(printf "Cursor ~a~n" f)
(printf "Cursor ~a\n" f)
(let ([c (send f get-cursor)])
(stv f set-cursor c)
(st c f get-cursor)
@ -131,7 +131,7 @@
(define (show-tests f)
(unless (is-a? f dialog%)
(printf "Show ~a~n" f)
(printf "Show ~a\n" f)
(let ([on? (send f is-shown?)])
(stv f show #f)
(when on?
@ -193,7 +193,7 @@
(st #f f get-menu-bar))]
[space-tests
(lambda ()
(printf "Spacing~n")
(printf "Spacing\n")
(let ([b (send f border)])
(stv f border 25)
(st 25 f border)
@ -209,14 +209,14 @@
(drop-file-tests f))]
[client->screen-tests
(lambda ()
(printf "Client<->Screen~n")
(printf "Client<->Screen\n")
(let-values ([(x y) (send f client->screen 0 0)])
(stvals '(0 0) f screen->client x y))
(let-values ([(x y) (send f screen->client 0 0)])
(stvals '(0 0) f client->screen x y)))]
[container-tests
(lambda ()
(printf "Container~n")
(printf "Container\n")
(area-tests f #t #t #t)
(let-values ([(x y) (send f container-size null)])
(st x f min-width)
@ -238,15 +238,15 @@
(container-tests)
(cursor-tests)
(printf "Init~n")
(printf "Init\n")
(init-tests #f)
(stv f show #t)
(pause)
(printf "Show Init~n")
(printf "Show Init\n")
(init-tests #t)
(stv f show #f)
(pause)
(printf "Hide Init~n")
(printf "Hide Init\n")
(init-tests #f)
(send f show #t)
(pause)
@ -258,7 +258,7 @@
(stv f change-children values)
(printf "Iconize~n")
(printf "Iconize\n")
(stv f iconize #t)
(pause)
(pause)
@ -272,7 +272,7 @@
(stv f maximize #f)
(pause)
(printf "Move~n")
(printf "Move\n")
(stv f move 34 37)
(pause)
(FAILS (st 34 f get-x))
@ -280,7 +280,7 @@
(st 150 f get-width)
(st 151 f get-height)
(printf "Resize~n")
(printf "Resize\n")
(stv f resize 56 57)
(pause)
(FAILS (st 34 f get-x))
@ -306,7 +306,7 @@
(cursor-tests)
(printf "Menu Bar~n")
(printf "Menu Bar\n")
(let ([mb (make-object menu-bar% f)])
(st mb f get-menu-bar)
(st f mb get-frame)
@ -320,11 +320,11 @@
(st null mb get-items)
(printf "Menu 1~n")
(printf "Menu 1\n")
(let* ([m (make-object menu% "&File" mb)]
[i m]
[delete-enable-test (lambda (i parent empty)
(printf "Item~n")
(printf "Item\n")
(st #f i is-deleted?)
(st #t i is-enabled?)
@ -371,7 +371,7 @@
(st null m get-items)
(printf "Menu Items~n")
(printf "Menu Items\n")
(let ([i1 (make-object menu-item% "&Plain" m
(lambda (i e)
(test-control-event e '(menu))
@ -391,7 +391,7 @@
(lambda (i empty name)
(delete-enable-test i m empty)
(printf "Shortcut~n")
(printf "Shortcut\n")
(set! hit i)
(stv i command (make-object control-event% 'menu))
(test name 'hit-command hit)
@ -437,7 +437,7 @@
'done)
(printf "Menu 2~n")
(printf "Menu 2\n")
(let* ([m2 (make-object menu% "&Edit" mb "Help Edit")]
[i2 m2])
(st (list i i2) mb get-items)
@ -468,7 +468,7 @@
(define (test-controls parent frame)
(define side-effect #f)
(printf "Buttons~n")
(printf "Buttons\n")
(letrec ([b (make-object button%
"&Button"
parent
@ -484,7 +484,7 @@
(containee-window-tests b #f #f parent frame 2))
(printf "Check Box~n")
(printf "Check Box\n")
(letrec ([c (make-object check-box%
"&Check Box"
parent
@ -511,7 +511,7 @@
#t)])
(st #t c get-value))
(printf "Radio Box~n")
(printf "Radio Box\n")
(letrec ([r (make-object radio-box%
"&Radio Box"
(list "O&ne" "T&wo" "T&hree")
@ -586,7 +586,7 @@
'(vertical)
3))
(printf "Gauge~n")
(printf "Gauge\n")
(letrec ([g (make-object gauge%
"&Gauge"
10
@ -618,7 +618,7 @@
(containee-window-tests g #t #f parent frame 2))
(printf "Slider~n")
(printf "Slider\n")
(letrec ([s (make-object slider%
"&Slider"
-2 8
@ -774,7 +774,7 @@
'done-list)])
(printf "Choice~n")
(printf "Choice\n")
(letrec ([c (make-object choice%
"&Choice"
'("A" "B" "C & D")
@ -808,7 +808,7 @@
(let ([mk-list
(lambda (style)
(printf "List Box: ~a~n" style)
(printf "List Box: ~a\n" style)
(letrec ([l (make-object list-box%
"&List Box"
'("A" "B" "C & D")
@ -869,7 +869,7 @@
(let ([c (make-object canvas% parent '(hscroll vscroll))])
(printf "Tab Focus~n")
(printf "Tab Focus\n")
(st #f c accept-tab-focus)
(stv c accept-tab-focus #t)
(st #t c accept-tab-focus)
@ -880,7 +880,7 @@
; (stv c set-scrollbars 100 101 5 6 2 3 10 20 #t)
(let-values ([(w h) (send c get-virtual-size)]
[(cw ch) (send c get-client-size)])
(printf "Canvas size: Virtual: ~a x ~a Client: ~a x ~a~n" w h cw ch)
(printf "Canvas size: Virtual: ~a x ~a Client: ~a x ~a\n" w h cw ch)
(let ([check-scroll
(lambda (xpos ypos)
(let-values ([(x y) (send c get-view-start)])
@ -958,7 +958,7 @@
102)])
(let loop ([n 100])
(unless (zero? n)
(send e insert (format "line ~a~n" n))
(send e insert (format "line ~a\n" n))
(loop (sub1 n))))
(st #f c allow-scroll-to-last)