;******************************************************************************
;
; Project       : STk-inspect, a graphical debugger for STk
;
; File name     : inspect-main.stk
; Creation date : Aug-10-1993
; Last update   : Sep-17-1993
;
;******************************************************************************
;
; This file implements the "General inspector".
;
;******************************************************************************

(provide "inspect-main")
(require "inspect-misc")
(require "inspect-view")
(require "inspect-detail")
(require "inspect-help")

(define INSPECTOR_WIDGET_NAME 	 ".inspector")
(define inspected-objects-list   ())

(define (inspected? obj) (member obj inspected-objects-list))

(define (inspect-frame-wid obj)
  (widget INSPECTOR_WIDGET_NAME ".f1." (object-symbol obj)))
(define (inspect-frame-str obj)
  (& INSPECTOR_WIDGET_NAME ".f1." (object-symbol obj)))

(define (inspect-l-wid obj) (widget (inspect-frame-str obj) ".l"))
(define (inspect-l-str obj) (& (inspect-frame-str obj) ".l"))
(define (inspect-e-wid obj) (widget (inspect-frame-str obj) ".e"))
(define (inspect-e-str obj) (& (inspect-frame-str obj) ".e"))
(define (inspect-mb-wid obj) (widget (inspect-frame-str obj) ".mb"))
(define (inspect-mb-str obj) (& (inspect-frame-str obj) ".mb"))
(define (inspect-m-str obj) (& (inspect-frame-str obj) ".mb.m"))
(define (inspect-m-wid obj) (widget (inspect-frame-str obj) ".mb.m"))


;---- Inspector menu

(define (create-inspect-menu obj)
  (define w (eval [menu (inspect-m-str obj)]))
  (w 'add 'command :label "Uninspect" 
     		   :command `(inspect-menu-Uninspect ',(object-symbol obj)))
  (w 'add 'command :label "Detail"
     		   :command `(inspect-menu-Detail ',(object-symbol obj)))
  (if (detailed? obj) ((inspect-m-wid obj) 'disable "Detail"))
  (w 'add 'command :label "View" 
     		   :command `(inspect-menu-View ',(object-symbol obj)))
  (if (viewed? obj) ((inspect-m-wid obj) 'disable "View")))

(define (inspect-menu-Eval obj)
  (eval-string (format #f "(set! ~a ~a)" obj ((inspect-e-wid obj) 'get))))

(define (inspect-menu-Quote obj)
  (eval-string (format #f "(set! ~a '~a)" obj ((inspect-e-wid obj) 'get))))

(define (inspect-menu-Uninspect key)
  (uninspect (find-object-infos  key)))

(define (inspect-menu-Detail key)
  (let ((obj (find-object-infos  key)))
    (detail obj)
    ((inspect-m-wid obj) 'disable "Detail")
    (if (viewed? obj) ((view-m-wid obj) 'disable "Detail"))))

(define (inspect-menu-View key)
  (let ((obj (find-object-infos  key)))
    (view obj)
    ((inspect-m-wid obj) 'disable "View")
    (if (detailed? obj) ((detail-m-wid obj) 'disable "View"))))

(define (create-inspector)
  (define w [toplevel INSPECTOR_WIDGET_NAME])
  (wm 'title w "General inspector")
  (wm 'maxsize w SCREEN_WIDTH SCREEN_HEIGHT)
  (define menu-w (create-menu-widget (& INSPECTOR_WIDGET_NAME ".menu")))
  (pack menu-w :side "top" :fill "x" :padx 4 :pady 2)
  ((widget menu-w ".help.m") 'add 'command :label "General inspector"
			     :command '(stk:make-help General-Inspector-help))
  (pack [menubutton (& INSPECTOR_WIDGET_NAME ".menu.command") :text "Command"]
	:side "left")
  (define cmd-w (eval [menu (& INSPECTOR_WIDGET_NAME ".menu.command.m")]))
  (cmd-w 'add 'command :label "Uninspect all" :command '(destroy-inspector))
  (cmd-w 'add 'command :label "Undebug" :command '(undebug))
  (tk-set! (widget INSPECTOR_WIDGET_NAME ".menu.command") :menu cmd-w)
  (pack [frame (& INSPECTOR_WIDGET_NAME ".caption")]
	:side "top" :fill "x" :padx 4)
  (pack [label (& INSPECTOR_WIDGET_NAME ".caption.l1")
	       :text "Objects" :width 20]
	:side "left")
  (pack [label (& INSPECTOR_WIDGET_NAME ".caption.l2")
	       :text "Values" :width 40]
	:side "left" :padx 4)
  (pack [frame (& INSPECTOR_WIDGET_NAME ".f1")]
	:fill "both" :expand "yes" :padx 4 :pady 2))


(define (destroy-inspector) 
  (for-each uninspect-object inspected-objects-list))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; inspect
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (inspect obj)
  (when (= (winfo 'exist INSPECTOR_WIDGET_NAME) 0) (create-inspector))
  ;; Kludge to avoid problems . Should be modified [eg]
  (let ((obj-val (inspect::eval obj)))
    (when (eqv? (inspect::typeof obj-val) 'widget)
	  (set! obj obj-val)))

  (unless (inspected? obj)
     (inspect-object obj)
     (let ((obj-val (format #f "~S" (inspect::eval obj))))
       (pack [frame (inspect-frame-str obj)] :side "top" :fill "x")
       (pack [menubutton (inspect-mb-str obj)
			 :relief "raised" :bd 2 :bitmap BITMAP_MENU]
	     :side "right")
       (pack [label (inspect-l-str obj) :relief "groove" :bd 2
		    :anchor "w" :text (format #f "~S" obj)
		    :width 20 :font MEDIUM_FONT]
	     :side "left")
       (pack [entry (inspect-e-str obj) :relief "sunken" :bd 2 :width 40] 
	     :fill "x" :expand "yes" :padx 4)
       (create-inspect-menu obj)
       (tk-set! (inspect-mb-wid obj) :menu (inspect-m-wid obj))
       
       (let ((E (inspect-e-wid obj)))
	 (E 'insert 0 obj-val)

	 ;; If obj is a symbol, lets the entry modifiable. Otherwise let it as is
	 (if (modifiable-object? obj)
	     [begin
	       (bind E "<Return>" 	`(inspect-menu-Eval ',obj))
	       (bind E "<Shift-Return>" `(inspect-menu-Quote ',obj))]
	     [inspect::shadow-entry E]))))

  ;; Destroy Event -> set the list of inspected object to '()
  (bind  INSPECTOR_WIDGET_NAME "<Destroy>" '(set! inspected-objects-list '()))

  ;; Allow resizing only in width
  (update 'idletasks)
  (let ((req-h (winfo 'reqheight INSPECTOR_WIDGET_NAME)))
    (wm 'minsize INSPECTOR_WIDGET_NAME 0 req-h)
    (wm 'maxsize INSPECTOR_WIDGET_NAME SCREEN_WIDTH req-h)
    (wm 'geometry INSPECTOR_WIDGET_NAME 
	(& (winfo 'width INSPECTOR_WIDGET_NAME) "x" req-h))))

(define (inspect-object obj)
  (set! inspected-objects-list (cons obj inspected-objects-list))
  (unless (object-infos obj)
	  (add-object-infos obj)
	  (if (symbol? obj) (trace-var obj `(update-object ',obj)))))

(define (inspect-display obj)
  (let ((entry-w (inspect-e-wid obj)))
    (entry-w 'delete 0 'end)
    (entry-w 'insert 0 (->object (eval obj)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; uninspect
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (uninspect obj)
  (when (inspected? obj) (uninspect-object obj))     
  (update 'idletasks)
  (when (= (winfo 'exist INSPECTOR_WIDGET_NAME) 1)
	(let ((req-h (winfo 'reqheight INSPECTOR_WIDGET_NAME)))
	  (wm 'minsize INSPECTOR_WIDGET_NAME 0 req-h)
	  (wm 'maxsize INSPECTOR_WIDGET_NAME SCREEN_WIDTH req-h)
	  (wm 'geometry INSPECTOR_WIDGET_NAME 
	      (& (winfo 'width INSPECTOR_WIDGET_NAME) "x" req-h)))))


(define (uninspect-object obj)
  (set! inspected-objects-list (list-remove obj inspected-objects-list))
  (destroy (inspect-frame-wid obj))
  (when (null? inspected-objects-list) (destroy INSPECTOR_WIDGET_NAME))
  (if (detailed? obj) ((detail-m-wid obj) 'enable "Inspect"))
  (if (viewed? obj)   ((view-m-wid obj)   'enable "Inspect"))
  (unless (or (detailed? obj) (viewed? obj))
	  (remove-object-infos obj)
	  (if (symbol? obj) (untrace-var obj))))