original commit: 12287f8a0274d981ddf2f64ce5cfdd6dddc8aab0
This commit is contained in:
Robby Findler 2000-01-15 20:49:42 +00:00
parent 315e52614a
commit fda0aca5fd
4 changed files with 10 additions and 17 deletions

View File

@ -45,7 +45,7 @@
(string-append "Are you sure you want to "
w
"?")]
[(user-says) (gui-utils:get-choice message capw "Cancel")])
[(user-says) (gui-utils:get-choice message capw "Cancel" "Warning" #f)])
user-says)
#t))

View File

@ -1328,10 +1328,11 @@
(set-editor position-edit)
(stretchable-width #f)
(stretchable-height #f))
(determine-width "0000:000-0000:000"
(determine-width "0000:000-0000:000"
position-canvas
position-edit)
(editor-position-changed)
(send position-edit hide-caret #t)
(send position-edit lock #t))))
(define pasteboard-info<%> (interface (info<%>)))

View File

@ -5,7 +5,7 @@
(lambda ()
(with-handlers ([eof-result? (lambda (x) 'passed)])
(send-sexp-to-mred '(preferences:set 'framework:verify-exit #f))
(send-sexp-to-mred '(exit:exit))
(send-sexp-to-mred '(begin (exit:exit) (sleep/yield 1)))
'failed)))
(test 'exit/prompt
@ -65,7 +65,7 @@
`(begin
(preferences:set 'framework:verify-exit #f)
(exit:insert-can?-callback (lambda () (call-with-output-file ,tmp-file void) #t))
(exit:exit))))))
(begin (exit:exit) (sleep/yield 1)))))))
(test 'exit-callback-removed
(lambda (x) (and (eq? x 'passed) (not (mred-running?))))
@ -75,7 +75,7 @@
`(begin
(preferences:set 'framework:verify-exit #f)
((exit:insert-can?-callback (lambda () (error 'called-exit-callback))))
(exit:exit))))))
(begin (exit:exit) (sleep/yield 1)))))))
(test 'exit-callback-stops-exit
(lambda (x) (eq? x 'passed))

View File

@ -142,24 +142,18 @@
ov))))])
(pretty-print sexp)
(newline)))])
(printf "1~n")
(unless (and in-port
out-port
(or (not (char-ready? in-port))
(not (eof-object? (peek-char in-port)))))
(restart-mred))
(printf " ~a // ~a: sending to mred:~n" section-name test-name)
(printf "2~n")
(show-text sexp)
(printf "3~n")
(write sexp out-port)
(printf "4~n")
(newline out-port)
(printf "5~n")
(let ([answer
(with-handlers ([(lambda (x) #t)
(lambda (x)
(printf "8 ~a~n" (exn-message x))
(list 'cant-read
(string-append
(exn-message x)
@ -168,18 +162,17 @@
string
(let loop ()
(if (char-ready? in-port)
(cons (read-char in-port)
(loop))
(let ([char (read-char in-port)])
(if (eof-object? char)
null
(cons char (loop))))
null))))))])
(printf "6~n")
(read in-port))])
(unless (or (eof-object? answer)
(and (list? answer)
(= 2 (length answer))))
(error 'send-sexp-to-mred "unpected result from mred: ~s~n" answer))
(printf "7~n")
(if (eof-object? answer)
(raise (make-eof-result))
(case (car answer)
@ -210,7 +203,6 @@
(sexp/proc)
(begin0 (send-sexp-to-mred sexp/proc)
(send-sexp-to-mred ''check-for-errors)))])
(not (passed? result))))])
(when failed
(printf "FAILED ~a: ~a~n" failed test-name)