Fixes for inspector, introduce ,inspect command
part of darcs patch Thu Sep 22 13:24:07 EEST 2005 Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
		
							parent
							
								
									2fe9ca9f66
								
							
						
					
					
						commit
						45f1bb41b3
					
				| 
						 | 
					@ -99,9 +99,6 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (inspect-value val)
 | 
					 | 
				
			||||||
  (error "not yet"))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(define key-d 100)
 | 
					(define key-d 100)
 | 
				
			||||||
(define key-u 117)
 | 
					(define key-u 117)
 | 
				
			||||||
(define key-return 10)
 | 
					(define key-return 10)
 | 
				
			||||||
| 
						 | 
					@ -136,7 +133,8 @@
 | 
				
			||||||
    (define (inspect-next-continuation)
 | 
					    (define (inspect-next-continuation)
 | 
				
			||||||
      (if (continuation? val)
 | 
					      (if (continuation? val)
 | 
				
			||||||
          (push-val! (continuation-parent val))
 | 
					          (push-val! (continuation-parent val))
 | 
				
			||||||
          (set-header-message! header
 | 
					          (set-header-message! 
 | 
				
			||||||
 | 
					           header
 | 
				
			||||||
           "Can't go down from a non-continuation.")))
 | 
					           "Can't go down from a non-continuation.")))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    (define (pop-val!)
 | 
					    (define (pop-val!)
 | 
				
			||||||
| 
						 | 
					@ -206,4 +204,15 @@
 | 
				
			||||||
         (debug-message "inspector did not handle message " message))))))
 | 
					         (debug-message "inspector did not handle message " message))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(register-plugin! 
 | 
					(register-plugin! 
 | 
				
			||||||
 (make-view-plugin make-inspector exception-continuation?))
 | 
					 (make-view-plugin make-inspector 
 | 
				
			||||||
 | 
					                   exception-continuation?))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define-record-type inspection-object :inspection-object
 | 
				
			||||||
 | 
					  (make-inspection-object val)
 | 
				
			||||||
 | 
					  inspection-object?
 | 
				
			||||||
 | 
					  (val inspection-object-val))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(register-plugin! 
 | 
				
			||||||
 | 
					 (make-view-plugin (lambda (iv buffer)
 | 
				
			||||||
 | 
					                     (make-inspector (inspection-object-val iv) buffer))
 | 
				
			||||||
 | 
					                  inspection-object?))
 | 
				
			||||||
| 
						 | 
					@ -288,8 +288,9 @@
 | 
				
			||||||
    
 | 
					    
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (eval-command-in-scheme-mode command-line)
 | 
					(define (eval-command-in-scheme-mode command-line)
 | 
				
			||||||
  (with-fatal-error-handler* 
 | 
					  (with-fatal-and-capturing-error-handler
 | 
				
			||||||
   display-error-and-continue
 | 
					   (lambda (condition raw-continuation continuation decline)
 | 
				
			||||||
 | 
					     raw-continuation)
 | 
				
			||||||
   (lambda ()
 | 
					   (lambda ()
 | 
				
			||||||
     (if (scheme-command-line? command-line)
 | 
					     (if (scheme-command-line? command-line)
 | 
				
			||||||
         (process-scheme-command command-line)
 | 
					         (process-scheme-command command-line)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -432,10 +432,13 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
;;; inspector
 | 
					;;; inspector
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-interface nuit-inspector-interface
 | 
					(define-interface inspection-objects-interface
 | 
				
			||||||
  (export inspect-value))
 | 
					  (export make-inspection-object
 | 
				
			||||||
 | 
					          inspection-object?))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-structure nuit-inspector-plugin nuit-inspector-interface
 | 
					(define-structures 
 | 
				
			||||||
 | 
					  ((nuit-inspector-plugin (export))
 | 
				
			||||||
 | 
					   (inspection-objects inspection-objects-interface))
 | 
				
			||||||
  (open scheme
 | 
					  (open scheme
 | 
				
			||||||
        inspector-internal
 | 
					        inspector-internal
 | 
				
			||||||
        continuations
 | 
					        continuations
 | 
				
			||||||
| 
						 | 
					@ -514,6 +517,7 @@
 | 
				
			||||||
        package-commands-internal
 | 
					        package-commands-internal
 | 
				
			||||||
        package-mutation
 | 
					        package-mutation
 | 
				
			||||||
        
 | 
					        
 | 
				
			||||||
 | 
					        inspection-objects
 | 
				
			||||||
        eval-environment)
 | 
					        eval-environment)
 | 
				
			||||||
  (files scheme-commands))
 | 
					  (files scheme-commands))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -2,7 +2,7 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (split-scheme-command-line command-line)
 | 
					(define (split-scheme-command-line command-line)
 | 
				
			||||||
  (let ((tokens (string-tokenize command-line)))
 | 
					  (let ((tokens (string-tokenize command-line)))
 | 
				
			||||||
    (values (string->symbol (string-drop (car tokens) 1))
 | 
					    (values (string-drop (car tokens) 1)
 | 
				
			||||||
            (cdr tokens))))
 | 
					            (cdr tokens))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (scheme-command-line? command-line)
 | 
					(define (scheme-command-line? command-line)
 | 
				
			||||||
| 
						 | 
					@ -10,8 +10,8 @@
 | 
				
			||||||
          command-prefix))
 | 
					          command-prefix))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (eval-scheme-command command args)
 | 
					(define (eval-scheme-command command args)
 | 
				
			||||||
  (case command
 | 
					  (case (string->symbol command)
 | 
				
			||||||
    ((in) 
 | 
					    ((in)
 | 
				
			||||||
     (set-evaluation-package! (string->symbol (car args)))
 | 
					     (set-evaluation-package! (string->symbol (car args)))
 | 
				
			||||||
     (string-append "moved to package " (car args)))
 | 
					     (string-append "moved to package " (car args)))
 | 
				
			||||||
    ((open)
 | 
					    ((open)
 | 
				
			||||||
| 
						 | 
					@ -24,4 +24,11 @@
 | 
				
			||||||
    ((user)
 | 
					    ((user)
 | 
				
			||||||
     (set-evaluation-package! 'nuit-eval)
 | 
					     (set-evaluation-package! 'nuit-eval)
 | 
				
			||||||
     "moved to package nuit-eval")
 | 
					     "moved to package nuit-eval")
 | 
				
			||||||
    (else (error "unknwon scheme command"))))
 | 
					    ((inspect)
 | 
				
			||||||
 | 
					     (if (null? args)
 | 
				
			||||||
 | 
					         ",inspect requires an argument"
 | 
				
			||||||
 | 
					         (make-inspection-object 
 | 
				
			||||||
 | 
					          (eval-string (string-join args)))))
 | 
				
			||||||
 | 
					    ((exit)
 | 
				
			||||||
 | 
					     (exit))
 | 
				
			||||||
 | 
					    (else (error "unknwon scheme command" command))))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue