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