;;; -*- Mode:Common-Lisp; Package:EH; Base:8; Fonts:(CPTFONT HL10B HL12BI HL12B CPTFONTB)Ï1; Ï*Patch-File: T -*-

;Ï1;;                     RESTRICTED RIGHTS LEGEND          Ï*
;Ï1;; Use, duplication, or disclosure by the Government is subject toÏ*
;Ï1;; restrictions as set forth in subdivision (b)(3)(ii) of the Rights inÏ*
;Ï1;; Technical Data and Computer Software clause at 52.227-7013.Ï*
;Ï1;;                   TEXAS INSTRUMENTS INCORPORATED.Ï*
;Ï1;;                            P.O. BOX 149149Ï*
;Ï1;;                         AUSTIN, TEXAS 78714-9149Ï*
;Ï1;;                             MS 2151Ï*
;Ï1;; Copyright (C) 1986,1987, 1988, 1989 Texas Instruments Incorporated. All rights reserved.Ï*
;Ï1;----------------------------------------------------------------------Ï*
;Ï1;; This software developed by:Ï*
;Ï1;;Ï*	Ï1James RiceÏ*
;Ï1;; at the Stanford University Knowledge Systems Lab in 1986, 1987.Ï*
;Ï1;;Ï*
;Ï1;; This work was supported in part by:Ï*
;Ï1;;Ï*	Ï1DARPA Grant F30602-85-C-0012Ï*

;Ï1;;----------------------------------------------------------------------Ï*
;Ï1;;  Much of this file is derived from code licensed from Texas InstrumentsÏ*
;Ï1;;  Inc.  Since we'd like them to adopt these changes, we're claimingÏ*
;Ï1;;  no rights to them, however, the following restrictions apply to theÏ*
;Ï1;;  TI code:Ï*
;Ï1;; Your rights to use and copy Explorer System Software must be obtainedÏ*
;Ï1;; directly by license from Texas Instruments Incorporated.  UnauthorizedÏ*
;Ï1;; use is prohibited.Ï*

;Ï1***************Ï*
;Ï1 TAC 07-25-89 - commented out load-tools - not using Rice's load-tools system Ï*
;Ï1(load-tools '(:window-debugger-enhancements))Ï*

(DEFFLAVOR Ï4l2-debugger-who-line-mixinÏ* ()
	   (debugger-who-line-mixin)
  (:documentation 
    :combination "Ï3A version of DEBUGGER-WHO-LINE-MIXIN, which supports L2 protocols.Ï*"))

(DEFMETHOD Ï4(l2-debugger-who-line-mixin :after :initÏ*) (IGNORE)
  (SETQ normal-mouse-doc
	'(:mouse-l-1 "Ï3Inspect selected object.Ï*"
	  :mouse-m-1 "Ï3Set * to object; Echo object in interaction pane.Ï*")))

(DEFMETHOD Ï4(l2-debugger-who-line-mixin :get-normal-mouse-docÏ*) ()
  (LET ((item (IF (OR (SEND self :send-if-handles :sensitive-inspect-item)
		      (SEND self :send-if-handles :sensitive-history-item)
		      (SEND self :send-if-handles :current-item))
		  (tv::get-mouse-sensitive-item)
		  nil)))
       (MULTIPLE-VALUE-BIND (perspectives thing)
	   (IF (AND (CONSP item) (THIRD item)
		    (EQUAL :item1 (FIRST item)))
	       (IF (tv::allocated-perspectives (THIRD item))
		   (VALUES (tv::allocated-perspectives (THIRD item)) (THIRD item))
		   (VALUES nil (THIRD item)))
	       (IF (AND item (tv::allocated-perspectives item))
		   (VALUES (tv::allocated-perspectives item) item)
		   (IF (AND (EQUAL
			      (SEND self :send-if-handles :print-function-arg)
			      :list-structure)
			    (LOCATIVEP item)
			    (%p-contents-safe-p item)
			    (tv::allocated-perspectives (FIRST item)))
		       (VALUES (tv::allocated-perspectives (FIRST item)) (FIRST item)))))
           (IGNORE perspectives)
	   (APPEND (SEND (IF (TYPEP thing 'tv::inspection-data)
                             thing
                             (tv::map-into-show-x thing t))
                         :who-line-doc
                         t (NOT thing))
		   '(:allow-override "")
                   normal-mouse-doc))))

(DEFMETHOD Ï4(l2-debugger-who-line-mixin :who-line-documentation-stringÏ*) ()
  "Ï2Who line documentation for the stack, args, locals, history and inspection panes.Ï*"
  (LET*
    ((frame (SEND self :superior))
     (interactor (SEND frame :get-pane 'lisp-window)))
    (OR (SEND frame :who-line-doc-string-overide)
	(IF (SEND frame :doing-typein-p)
	    (SEND interactor :who-line-documentation-string)
	    (MULTIPLE-VALUE-BIND (x y) ;Ï1get mouse positionÏ*
		(tv:sheet-calculate-offsets self tv:mouse-sheet)
	      (SETQ x (- system:mouse-x x)
		    y (- system:mouse-y y))
	      (MULTIPLE-VALUE-BIND (item item-type)
		  (SEND self :mouse-sensitive-item x y)
		(COND ((NOT (OR item item-type))
		       '(:mouse-r-1 "Ï3Menu of all window-based debugger commandsÏ*"))
		      (t
		       ;Ï1; Change here by JPR.Ï*
                       (OR (CATCH-ERROR (SEND self :get-normal-mouse-doc) nil)
			   "Ï3Error getting doc string.Ï*")))))))))

(DEFFLAVOR Ï4l2-gray-debugger-text-scroll-paneÏ*
           nil
           (l2-debugger-who-line-mixin gray-debugger-text-scroll-pane)
           (:documentation :combination "Ï3Args window in window-based debuggerÏ*"))

(DEFFLAVOR Ï4l2-gray-debugger-thermometer-text-scroll-paneÏ*
           nil
           (l2-debugger-who-line-mixin gray-debugger-thermometer-text-scroll-pane)
           (:documentation :combination "Ï3Locals window in window-based debuggerÏ*"))

(DEFFLAVOR Ï4l2-stack-scroll-paneÏ*
           ()
           (l2-debugger-who-line-mixin stack-scroll-pane)
           (:documentation :combination "Ï3Stack window in the window-based debuggerÏ*"))

;Ï1***************Ï*
;Ï1 TAC 08-04-89 - This redefines flavor in WINDOW-DEBUG. It requires that GENERAL-INSPECTORÏ*
;Ï1                info be compiled first.Ï*
(DEFFLAVOR Ï4debugger-history-paneÏ*
           nil
           (debugger-who-line-mixin tv::general-inspector-history-window))

(DEFFLAVOR Ï4l2-debugger-history-paneÏ*
           nil
           (l2-debugger-who-line-mixin debugger-history-pane))

(DEFFLAVOR Ï4new-debugger-inspect-paneÏ* nil (l2-debugger-who-line-mixin tv::general-inspect-window))

(DEFFLAVOR Ï4new-debugger-frameÏ* () (debugger-frame))

(DEFMETHOD Ï4(debugger-frame :before :initÏ*) (IGNORE)
  (UNLESS (AND (boundp-in-instance self 'tv::panes) tv::panes)
  (LET ((io-buf (tv:make-default-io-buffer)))
    (SETQ
      tv::panes
      (LIST 
        `(lisp-window debugger-lisp-listener-pane :label nil :io-buffer ,io-buf)
        `(args-window gray-debugger-text-scroll-pane :label nil :font-map (,fonts:cptfont)
          :io-buffer ,io-buf)
       `(locals-window gray-debugger-thermometer-text-scroll-pane :label nil :font-map (,fonts:cptfont)
          :io-buffer ,io-buf)
        `(stack-window stack-scroll-pane
                       :label nil :io-buffer ,io-buf)
        `(command-menu-window debugger-menu-pane :io-buffer ,io-buf :font-map 
                              (,fonts:cptfont ,fonts:hl10b))
        `(resume-menu-window debugger-menu-pane :io-buffer ,io-buf :font-map 
                             (,fonts:cptfont ,fonts:hl10b))
        `(inspect-window debugger-inspect-pane :io-buffer ,io-buf :font-map (,fonts:cptfont) 
                         :label fonts:hl10b) ;Ï1:SCROLL-BAR-ALWAYS-DISPLAYED T :SCROLL-BAR 2)Ï*
        `(inspect-history-window debugger-history-pane :font-map (,fonts:cptfont)
                                 :io-buffer ,io-buf)))
    (SETQ tv:constraints
          (QUOTE
            ((debugger-configuration (inspect-window args-locals
                                                     stack-window
                                                     menu-history
                                                     lisp-window)
                                     ((menu-history :horizontal
                                                    (5 :lines command-menu-window)
                                                    (command-menu-window resume-menu-window
                                                                         inspect-history-window)
                                                    ((command-menu-window :ask :pane-size))
                                                    ((resume-menu-window :ask :pane-size))
                                                    ((inspect-history-window :even))))
                                     ((args-locals :horizontal
                                                   (6 :lines args-window)
                                                   (args-window locals-window)
                                                   ((args-window :even) (locals-window :even))))
                                     ((lisp-window 7 :lines))
                                     ((inspect-window 0.45s0) (stack-window 0.55s0)))
             (step-configuration
               (stack-window menu-args-locals lisp-window)
               ((menu-args-locals
                  :horizontal
                  (11 :lines command-menu-window)
                  (command-menus args-window locals-window)
                  ((command-menus :vertical
                                  (17 :characters command-menu-window)
                                  (command-menu-window resume-menu-window)
                                  ((command-menu-window :even) (resume-menu-window :even))))
                  ((args-window :even) (locals-window :even))))
               ((lisp-window 7 :lines))
               ((stack-window :even)))))))))

;Ï1; RDA: 1-May-89: Add thisÏ*
(DEFVAR Ï4*debugger-frame-default-edges*Ï* nil
  "Ï2If non-NIL, edges used by default when creating NEW-DEBUGGER-FRAMEs.Ï*")

(DEFMETHOD Ï4(new-debugger-frame :before :initÏ*) (init-plist-pointer)
  ;Ï1; RDA: 1-May-89: Add this and change from IGNORE in arglistÏ*
  (WHEN (AND *debugger-frame-default-edges*
	     (NOT (MEMBER :edges (CONTENTS init-plist-pointer) :test #'EQ)))
    (NCONC (CONTENTS init-plist-pointer) `(:edges ,*debugger-frame-default-edges*)))
  (UNLESS (AND (boundp-in-instance self 'tv::panes) tv::panes)
  (LET ((io-buf (tv:make-default-io-buffer)))
    (SETQ
      tv::panes
      (LIST 
        `(lisp-window debugger-lisp-listener-pane :label nil :io-buffer ,io-buf)
        `(args-window l2-gray-debugger-text-scroll-pane :label nil :font-map (,fonts:cptfont)
          :io-buffer ,io-buf)
        `(locals-window l2-gray-debugger-thermometer-text-scroll-pane :label nil :font-map (,fonts:cptfont)
          :io-buffer ,io-buf)
        `(stack-window l2-stack-scroll-pane
                       :label nil :io-buffer ,io-buf)
        `(command-menu-window debugger-menu-pane :io-buffer ,io-buf :font-map 
                              (,fonts:cptfont ,fonts:hl10b))
        `(resume-menu-window debugger-menu-pane :io-buffer ,io-buf :font-map 
                             (,fonts:cptfont ,fonts:hl10b))
        `(inspect-window new-debugger-inspect-pane :io-buffer ,io-buf :font-map (,fonts:cptfont) 
                         :label fonts:hl10b) ;Ï1:SCROLL-BAR-ALWAYS-DISPLAYED T :SCROLL-BAR 2)Ï*
        `(inspect-history-window l2-debugger-history-pane :font-map (,fonts:cptfont)
                                 :io-buffer ,io-buf)))
    (SETQ tv:constraints
          (QUOTE
            ((debugger-configuration (inspect-window args-locals
                                                     stack-window
                                                     menu-history
                                                     lisp-window)
                                     ((menu-history :horizontal
                                                    (5 :lines command-menu-window)
                                                    (command-menu-window resume-menu-window
                                                                         inspect-history-window)
                                                    ((command-menu-window :ask :pane-size))
                                                    ((resume-menu-window :ask :pane-size))
                                                    ((inspect-history-window :even))))
                                     ((args-locals :horizontal
                                                   (6 :lines args-window)
                                                   (args-window locals-window)
                                                   ((args-window :even) (locals-window :even))))
                                     ((lisp-window 7 :lines))
                                     ((inspect-window 0.45s0) (stack-window 0.55s0)))
             (step-configuration
               (stack-window menu-args-locals lisp-window)
               ((menu-args-locals
                  :horizontal
                  (11 :lines command-menu-window)
                  (command-menus args-window locals-window)
                  ((command-menus :vertical
                                  (17 :characters command-menu-window)
                                  (command-menu-window resume-menu-window)
                                  ((command-menu-window :even) (resume-menu-window :even))))
                  ((args-window :even) (locals-window :even))))
               ((lisp-window 7 :lines))
               ((stack-window :even)))))))))

(DEFMETHOD Ï4(new-debugger-frame :around :handle-unknown-inputÏ*) (cont mt ignore)
  (LET (operation value window list (sg *error-sg*))
    (WHEN (LISTP ucl:kbd-input)
      (SETQ list ucl:kbd-input
            operation (FIRST list)
            value (SECOND list)
            window (THIRD list))
      (WHEN (NOT (MEMBER operation '(:line-area :mouse-button) :test (FUNCTION eq)))
        (IF (EQL (INT-CHAR (FOURTH list)) #\Mouse-l)		;Ï1.Ï*
            (SETQ operation :inspect)
            (IF (SEND *window-debugger* :inspect-window-p window)
                (SETQ operation :value
                      value (tv::inspect-real-value list))))))
    (IF (NOT (MEMBER operation '(:line-area :inspect :value :function stack-frame special arg 
                                            local) :test (FUNCTION eq)))
        (FUNCALL-WITH-MAPPING-TABLE cont mt :handle-unknown-input)
        (CASE operation
	  (:line-area
	   (UNLESS (SEND *window-debugger* :inspect-window-p window)	;Ï1see above comments!Ï*
	     (SETQ *current-frame* value)
	     (SEND *window-debugger* :setup-frame sg *current-frame*)))
	  (:inspect
	   (IF (SEND *window-debugger* :inspect-window-p window)
	       (CASE (FOURTH ucl::kbd-input)
		 (#\Mouse-l-2 (SEND self :inspect-info-left-2-click))
		 (otherwise (LET ((ivalue (tv::inspect-real-value list)))
			      (IF (AND (NOT tv::*debugging?*)
				       (TYPEP ivalue 'tv::inspection-data)
				       (operation-handled-p ivalue :handle-mouse-click)
				       (CATCH-ERROR 
					 (PROGN 
					   (SEND ivalue :handle-mouse-click ucl:kbd-input *window-debugger*) 
					   t) 
					 nil))
				  nil
				  (SEND *window-debugger* :inspect-object ivalue)))))
	       (SEND *window-debugger* :inspect-object
		     (CASE (FIRST list)
		       (:menu  (EQ (SEND (FOURTH list) :execute (SECOND list)) t))
		       (stack-frame  (list-stack-frame-function-and-args *error-sg*
									 (SECOND list)))
		       (:line-area
			(list-stack-frame-function-and-args *error-sg*
							    (SECOND list)))
		       ((SPECIAL arg local)  (FIRST (SECOND list)))
		       ((:value :function)  (SECOND list))))))
	  ((LIST :value :function stack-frame special arg local)
	   (SETQ +++ ++
		 ++  +)
	   (COND
	     ((MEMBER operation '(SPECIAL arg local) :test (FUNCTION eq))
	      (COND
		((MEMBER operation '(arg local) :test (FUNCTION eq))
		 (PRIN1 (FIRST value))
		 (LET ((idx (SECOND value)))
		   (IF (NOT (NUMBERP idx))
		       (AND (EQUALP idx "Ï3Rest argÏ*")
			    (SETQ value (sg-rest-arg-value sg *current-frame*)))
		       (PROGN
			 (LET ((rp (sg-regular-pdl sg)))
			   (SETQ +
				 (ALOC rp
				       (+ idx
					  (IF (EQ operation 'arg) 
					      (sys:rp-argument-offset sg rp *current-frame*)
					      (sys:rp-local-offset sg rp *current-frame*))))))
								;Ï1; old way of looking for args and locals:Ï*
								;Ï1; (ALOC RPÏ*
								;Ï1;      (+ *CURRENT-FRAME* IDXÏ*
								;Ï1;Ï*	Ï1  (IF (EQ OPERATION 'ARG) 1Ï*
								;Ï1;                 (RP-LOCAL-BLOCK-ORIGINÏ*
								;Ï1;Ï*	Ï1      RP CURRENT-FRAME))))))Ï*
			 (SETQ value (CAR +))))))
		(t (SETQ + (PRIN1 value))
		   (SETQ value (SYMBOL-VALUE value))))
	      (TERPRI))
	     ((EQ operation 'stack-frame)
	      (SETQ value (stack-frame-into-list value sg)))
	     ((EQL (FOURTH ucl::kbd-input) #\Mouse-l-2)
	      (SEND self :inspect-info-left-2-click))
	     ((LET ((ivalue (tv::inspect-real-value list)))
		(AND (TYPEP ivalue 'tv::inspection-data)
		     (operation-handled-p ivalue :handle-mouse-click)
		     (CATCH-ERROR 
		       (PROGN 
			 (SEND ivalue :handle-mouse-click ucl:kbd-input *window-debugger*)
			 t) 
		       nil)))))
	   (SEND *terminal-io* :fresh-line)
	   (SETQ *** **
		 **  *
		 *   (IF (TYPEP value 'tv::inspection-data)
			 (SEND value :send-if-handles :middle-button-result)
			 value))
	   (IF (NOT (EQUAL #\mouse-l-2 (FOURTH ucl:kbd-input))) (PRINT *))
	   (SEND self :handle-prompt))))))

(PUTPROP :function 'SECOND 'tv::value-function)

(DEFMETHOD Ï4(new-debugger-frame :inspect-thingÏ*)
           (type thing &optional (aux-data nil aux-supplied?))
  (LET ((inspected-thing
	 (tv::inspect-real-value
	  `(:value
	    ,(IF aux-supplied?
	       (tv::allocate-data type thing aux-data)
	       (tv::allocate-data type thing))
	    ,inspect-history-window))))
    (SEND *window-debugger* :inspect-object inspected-thing)))

(DEFMETHOD Ï4(new-debugger-frame :inspect-info-left-2-clickÏ*)
	   (&optional something)
  (LET ((thing (IF something
		   something
		   (tv::inspect-real-value ucl:kbd-input))))
       (MULTIPLE-VALUE-BIND (real-thing inspect-p)
	   (tv::map-into-show-x thing)
	 (IF inspect-p
	     (SEND *window-debugger* :inspect-object real-thing)
	     nil))))

(DEFMETHOD Ï4(new-debugger-frame :inspection-data-active?Ï*) ()
  t)

(install-window-debugger-commands)

;Ï1(compile-flavor-methods l2-debugger-who-line-mixinÏ*
;			Ï1l2-gray-debugger-text-scroll-paneÏ*
;			Ï1l2-gray-debugger-thermometer-text-scroll-paneÏ*
;			Ï1l2-stack-scroll-paneÏ*
;			Ï1l2-debugger-history-paneÏ*
;			Ï1new-debugger-inspect-paneÏ*
;			Ï1new-debugger-frame
Ï*;Ï1)