73 lines
2.9 KiB
ArmAsm
73 lines
2.9 KiB
ArmAsm
;
|
||
; The following code is an example of an error handler for I/O errors. The
|
||
; function open-input-file attempts to open filename for input. Note that
|
||
; a continuation is saved in the fluid variable my%ioerr before the call to
|
||
; open-input-file. Upon return from the open, the variable port is
|
||
; interrogated to determine the status- To retry the operation with the same
|
||
; filename, retry the operation with a different filename, or return the port
|
||
; object.
|
||
;
|
||
|
||
(define (open-input-file filename)
|
||
(let ((port (call/cc
|
||
(fluid-lambda (my%ioerr)
|
||
((access open-input-file user-global-environment)
|
||
filename)))))
|
||
(cond ((eq? port 'retry)
|
||
(open-input-file filename))
|
||
((string? port)
|
||
(open-input-file port))
|
||
(else
|
||
port))))
|
||
|
||
;
|
||
; *USER-ERROR-HANDLER* has been designed to trap on all I/O errors, pop up a
|
||
; window to indicate the error, and illicit a response from the user. The
|
||
; result is then returned via the continuation bound to the fluid variable
|
||
; my%ioerr. The system error handler is called for all other errors.
|
||
;
|
||
; See the User's Guide for a discussion on user error handling and a list of
|
||
; all I/O errors.
|
||
;
|
||
|
||
(set! (access *user-error-handler* user-global-environment)
|
||
(lambda (error-num error-msg irritant sys-error-handler)
|
||
(if (and (fluid-bound? my%ioerr)
|
||
(number? error-num)
|
||
(>= error-num 1)
|
||
(<= error-num 88))
|
||
(let ((win (make-window error-msg #t))
|
||
(result '()))
|
||
(window-set-position! win 10 10)
|
||
(window-set-size! win 6 50)
|
||
(window-set-cursor! win 2 5)
|
||
(window-popup win)
|
||
(case error-num
|
||
((2 3) ;file/path not found
|
||
(display "File/Path not found : " win)
|
||
(display irritant win)
|
||
(newline win)
|
||
(display "Enter new pathname (or return to exit) - " win)
|
||
(set! result (read-line win))
|
||
(if (string=? result "")
|
||
(set! result '())))
|
||
((21) ;drive not ready
|
||
(display "Drive not ready - Retry (y/n)?" win)
|
||
(set! result
|
||
(if (char=? (char-upcase (read-char win)) #\Y)
|
||
'retry
|
||
'())))
|
||
(else
|
||
(display "Extended Dos I/O Error - " win)
|
||
(display irritant win)
|
||
(newline win)
|
||
(newline win)
|
||
(char-upcase (read-char win))
|
||
(set! result '())))
|
||
|
||
(window-popup-delete win)
|
||
((fluid my%ioerr) result))
|
||
;else
|
||
(sys-error-handler))))
|
||
|
||
|