Added a silly fatal-error-handler for EVAL-COMMAND-IN-SCHEME-MODE.
This commit is contained in:
parent
b46ff51a1c
commit
ffff7d3a60
|
@ -200,26 +200,45 @@
|
|||
(refresh-command-window)
|
||||
(release-lock paint-lock)))
|
||||
|
||||
(define (eval-command-in-scheme-mode command-line)
|
||||
(let ((viewer
|
||||
(find/init-plugin-for-result
|
||||
(eval-string command-line))))
|
||||
(let* ((tokens (split-command-line command-line))
|
||||
(command (car tokens))
|
||||
(args (cdr tokens))
|
||||
(new-entry
|
||||
(make-history-entry command args viewer)))
|
||||
;; #### shouldn't we use some kind of insertion here?
|
||||
(append-to-history! new-entry)
|
||||
(signal-result-buffer-object-change)
|
||||
(obtain-lock paint-lock)
|
||||
(paint-result-window new-entry)
|
||||
(refresh-result-window)
|
||||
(move-cursor (command-buffer) (result-buffer))
|
||||
(refresh-command-window)
|
||||
(release-lock paint-lock))))
|
||||
(define (display-error-and-continue condition more)
|
||||
(let ((win (app-window-curses-win (result-window))))
|
||||
(wclear win)
|
||||
(wattron win (A-BOLD))
|
||||
(mvwaddstr win 0 0
|
||||
(string-append "I'm sorry " (user-login-name) ", "
|
||||
"I'm afraid I can't do that. "
|
||||
"The following error occured:"))
|
||||
(wattrset win (A-NORMAL))
|
||||
(let ((string-port (open-output-string)))
|
||||
(display condition string-port)
|
||||
(display " " string-port)
|
||||
(display more)
|
||||
(mvwaddstr win 5 0 (get-output-string string-port)))
|
||||
(refresh-result-window)))
|
||||
|
||||
;; #### crufty
|
||||
(define (eval-command-in-scheme-mode command-line)
|
||||
(with-fatal-error-handler*
|
||||
display-error-and-continue
|
||||
(lambda ()
|
||||
(let ((viewer
|
||||
(find/init-plugin-for-result
|
||||
(eval-string command-line))))
|
||||
(let* ((tokens (split-command-line command-line))
|
||||
(command (car tokens))
|
||||
(args (cdr tokens))
|
||||
(new-entry
|
||||
(make-history-entry command args viewer)))
|
||||
;; #### shouldn't we use some kind of insertion here?
|
||||
(append-to-history! new-entry)
|
||||
(signal-result-buffer-object-change)
|
||||
(obtain-lock paint-lock)
|
||||
(paint-result-window new-entry)
|
||||
(refresh-result-window)
|
||||
(move-cursor (command-buffer) (result-buffer))
|
||||
(refresh-command-window)
|
||||
(release-lock paint-lock))))))
|
||||
|
||||
;; #### crufty, and a very dumb idea
|
||||
(define split-command-line string-tokenize)
|
||||
|
||||
(define (paste-selection/refresh viewer)
|
||||
|
|
Loading…
Reference in New Issue