(FILECREATED "20-SEP-83 18:19:18" {INDIGO}<LOOPS>SOURCES>LOOPSBROWSE.;11 55025  

      changes to:  (FNS LatticeBrowser.Show ClassBrowser.DefineSubclass ClassBrowser.MoveTo 
			LatticeBrowser.DeleteRoot Browse ClassBrowser.CopyTo 
			ClassBrowser.DeleteClassItem ClassBrowser.FindWhere ClassBrowser.RenamePart 
			LatticeBrowser.LeftFn LatticeBrowser.MiddleFn InstanceBrowser.GetSubs 
			InstanceBrowser.TitleFn InstanceBrowser.NewPath)
		   (CLASSES ClassBrowser LatticeBrowser InstanceBrowser)
		   (VARS BROWSEFNS BROWSECLASSES)

      previous date: "22-JUL-83 19:32:54" {INDIGO}<LOOPS>SOURCES>LOOPSBROWSE.;9)


(PRETTYCOMPRINT LOOPSBROWSECOMS)

(RPAQQ LOOPSBROWSECOMS ((* Copyright (c)
			   Xerox Corporation, 1983)
			(CLASSES * BROWSECLASSES)
			(FNS * BROWSEFNS)
			(VARS MaxLatticeHeight MaxLatticeWidth)))



(* Copyright (c) Xerox Corporation, 1983)


(RPAQQ BROWSECLASSES (ClassBrowser InstanceBrowser LatticeBrowser SupersBrowser MetaBrowser TextItem))
(DEFCLASSES ClassBrowser InstanceBrowser LatticeBrowser SupersBrowser MetaBrowser TextItem)
[DEFCLASS ClassBrowser
   (MetaClass Class Edited:                                  (* dgb: "20-SEP-83 16:55")
	      doc                                            (* A window containing a lattice displaying classes.)
	      )
   (Supers LatticeBrowser)
   (ClassVariables (LeftButtonItems ((Print*(PrintSummary (PP PP! PPV!(PPM (QUOTE PPMethod)
									   
								    "Prettyprint selected method")
							      PrintSummary))
				       "PrintSummary of class")
				     (Doc*(ClassDoc (ClassDoc MethodDoc IVDoc CVDoc))
				       
				"Documentation for Class, Methods, IVs and CVs
	Class is default")
				     (WhereIs (QUOTE FindWhere)
					      "Find location of method, iv, or cv")
				     (Unread (QUOTE Unread)
					     "Put class name in typein buffer")))
		   (MiddleButtonItems ((EM*(EditMethod ((EM (QUOTE EditMethod))
							(EM!(QUOTE EM!)
							  
				   "Edit method selected from Menu, making it local if necessary"))
						       "Edit method of class selected from Menu"))
				       (Add*(DefMethod ((Specialize (QUOTE DefineSubclass)
								    "Define a specialized subclass")
							DefMethod DefRSM AddIV AddCV
							(New (QUOTE SetItNew)
							     
						     "Set IT to a new instance of selected class")))
					 
	      "Add a new method, a specialized class, IV or CV to class, or make a new instance.")
				       (Delete DeleteClassItem 
					      "Delete one of Methods IVs CVs
or the class itself")
				       (Move*(MoveTo (MoveTo CopyTo))
					 "Move or copy")
				       (BoxNode (QUOTE BoxNode)
						"Draw a box around selected node")
				       (Rename*(QUOTE RenamePart)
					 "Rename some part of the class")
				       (Edit*(EditObject (EditObject (EditIVs (QUOTE (EditObject
										       -2 DE))
									      "Edit IVs of class")
								     (EditCVs (QUOTE (EditObject
										       -3 DE))
									      "Edit CVs of class")
								     (Inspect (QUOTE Inspect)
									      
									 "Inspect selected class")))
					 "Edit class")))
		   (LocalCommands (CopyTo BoxNode ClassDoc CVDoc DefineSubclass DeleteClassItem 
					  EditObject FindWhere FlipNode IVDoc MoveTo Recompute 
					  RenamePart Unread)))
   (InstanceVariables (title "Class Inheritance Lattice"))
   (Methods (ClassDoc ClassBrowser.ClassDoc args (object objname)
		      doc                                    (* Print out class documentation if there is any)
		      )
	    (CopyTo ClassBrowser.CopyTo args (object objName)
		    doc                                      (* Ask user whether to copy CVs IVs or Methods and then 
							     find which ones)
		    )
	    (DefineSubclass ClassBrowser.DefineSubclass args (object objName)
			    doc                              (* Define a new subclass, giving it a name typed in by 
							     user)
			    )
	    (DestroyAndRecompute ClassBrowser.DestroyAndRecompute args (object objName)
				 doc                         (* Destroy class and recompute lattice.)
				 )
	    (FindWhere ClassBrowser.FindWhere args (object objName)
		       doc                                   (* Ask user whether CVs IVs or Methods wanted and then 
							     find that one)
		       )
	    (GetSubs ClassBrowser.GetSubs args (obj objName)
		     doc                                     (* Returns subclasses of a class)
		     )
	    (LeftShiftSelect ClassBrowser.LeftShiftSelect args (object objName)
			     doc                             (* Ask user whether to move CVs IVs or Methodsand then 
							     find which ones)
			     )
	    (MoveTo ClassBrowser.MoveTo doc                  (* mjs: "16-MAR-83 15:06")
		    args
		    (object objName))
	    (Recompute ClassBrowser.Recompute args (class)
		       doc                                   (* Set self to instance of selected class)
		       )
	    (SetItNew ClassBrowser.SetItNew args (object objName)
		      doc                                    (*)
		      )
	    (RenameClass ClassBrowser.RenameClass args (object objName)
			 doc                                 (* Read in a new name for the class, and rename it)
			 )
	    (BoxNode ClassBrowser.BoxNode doc                (* Box selected node and unbox previous))
	    (RenamePart ClassBrowser.RenamePart args (object objName)
			doc                                  (* Ask user whether to rename CVs IVs or Methods or 
							     class and then find which ones)
			)
	    (CVDoc ClassBrowser.CVDoc args (class className)
		   doc                                       (* Show menu of classVariables and give documentation 
							     for each)
		   )
	    (IVDoc ClassBrowser.IVDoc args (class className)
		   doc                                       (* Show menu of classVariables and give documentation 
							     for each)
		   )
	    (DeleteClassItem ClassBrowser.DeleteClassItem args (class className)
			     doc                             (* Delete an item from a class, or the class itself)
			     ))]

[DEFCLASS InstanceBrowser
   (MetaClass Class doc 

          (* Follows the downward lattice in object named in subIV. If subIV is changed after display, will show the newly 
	  defined alternative lattice starting at the same starting points)


	      Edited:                                        (* dgb: "19-SEP-83 17:31")
	      )
   (Supers LatticeBrowser)
   (ClassVariables (TitleItems ((Recompute (QUOTE Recompute)
					   "Recompute lattice from starting objects")
				(NewPath (QUOTE NewPath)
					 "Change name of sub to be followed in computing lattice.")
				(AddRoot (QUOTE AddRoot)
					 "Add named item to startingList for browser")
				(DeleteRoot (QUOTE DeleteRoot)
					    "Delete named item on startinglist for browser")
				(SaveInIT (QUOTE SaveInIT)
					  "IT←<this browser>"))
			       doc                           (* Items for menu of selections in title of window)
			       ))
   (InstanceVariables (subIV NIL doc                         (* Name of instance variable which provides names and/or
							     pointers to subobjects)))
   (Methods (GetSubs InstanceBrowser.GetSubs doc             (* Gets a set of subs from an object for browsing.)
		     )
	    (NewPath InstanceBrowser.NewPath args (subName)
		     doc                                     (* Changes the name of the sub by which the lattice is 
							     computed, changes the title, and recomputes the graph)
		     ))]

[DEFCLASS LatticeBrowser
   (MetaClass Class Edited:                                  (* dgb: "20-SEP-83 16:50"))
   (Supers Window)
   (ClassVariables (LocalCommands (EditObject BoxNode Recompute AddStartingItem)
				  doc                        (* messages that should be sent to browser when item 
							     seleted in menu, even if object does understand them)
				  )
		   (TitleItems ((Recompute (QUOTE Recompute)
					   "Recompute lattice from starting objects")
				(AddRoot (QUOTE AddRoot)
					 "Add named item to startingList for browser")
				(DeleteRoot (QUOTE DeleteRoot)
					    "Delete named item on startinglist for browser")
				(SaveInIT (QUOTE SaveInIT)
					  "IT←<this browser>"))
			       doc                           (* Items for menu of selections in title of window)
			       )
		   (LeftButtonItems ((BoxNode (QUOTE BoxNode)
					      
				      "Draw box around selected node.
Unboxed by another BoxNode")
				     (PP (QUOTE PP)
					 "Prettyprint selected item"))
				    doc                      (* Menu items for LeftButton seletion -- Value sent as 
							     message to object or browser -- see LocalCommands)
				    )
		   (MiddleButtonItems ((Inspect (QUOTE Inspect)
						"'Inspect selected item")
				       (Edit (QUOTE EditObject)
					     "Edit selected item"))
				      doc                    (* Menu items for MiddleButton seletion -- Value sent as
							     message to object or browser -- see LocalCommands)
				      ))
   (InstanceVariables (window NIL doc                        (* Window for browsing)
			      DontSave
			      (Value))
		      (topAlign T doc                        (* Flg used to indicate whether graph should be aligned 
							     with the top or bottom of the window))
		      (title "Browser Window" doc            (* Title passed to GRAPHER package))
		      (startingList NIL doc                  (* list of objects used to compute this browser)
				    )
		      (lastSelectedObject NIL doc            (* last object selected)
					  DontSave Any)
		      (browseFont #((FONTCREATE (QUOTE (GACHA 10)))
				    FirstFetch ReplaceMe) DontSave Any)
		      (boxedNode NIL doc                     (* last item Boxed, if any)))
   (Methods (BoxNode LatticeBrowser.BoxNode args (object)
		     doc                                     (* Inverts the video around the node in the graph 
							     representing the object)
		     )
	    (DoSelectedCommand LatticeBrowser.DoSelectedCommand args (command obj objName)
			       doc                           (* does the selected command or forwards it to the 
							     object)
			       )
	    (EEObject LatticeBrowser.EEObject args (object objName)
		      doc                                    (* Call editor with EE on object)
		      )
	    (EditObject LatticeBrowser.EditObject args (object objName args)
			doc                                  (* Call editor with commands args)
			)
	    (FlashNode LatticeBrowser.FlashNode args (node N flashTime)
		       doc                                   (* Flip node N times)
		       )
	    (FlipNode LatticeBrowser.FlipNode args (object)
		      doc                                    (* Inverts the video around the node in the graph 
							     representing the object)
		      )
	    (GetLabel LatticeBrowser.GetLabel args (object)
		      doc                                    (* Get a label for an object to be displayed in the 
							     browser.)
		      )
	    (GetNodeList LatticeBrowser.GetNodeList args (browseList goodList)
			 doc

          (* Compute the node data structures of the tree starting at browseList. If goodList is given, only include 
	  elements of it. If goodList=T make it be browseList.)


			 )
	    (GetSubs LatticeBrowser.GetSubs args (object)
		     doc                                     (* Gets a set of subs from an object for browsing)
		     )
	    (HasObject LatticeBrowser.HasObject args (object))
	    (LeftSelection LatticeBrowser.LeftSelection args NIL doc 

          (* * Move object if CTRL down. Do LeftShiftSelect if SHIFT down. Else choose from LeftButtonItems)

)
	    (LeftShiftSelect LatticeBrowser.LeftShiftSelect args (object objname)
			     doc                             (* Called when item is selected with left key and LSHIFT
							     is down)
			     )
	    (ListObjects LatticeBrowser.ListObjects args (object)
			 doc                                 (* return a list of the objects that are being displayed
							     in the browser)
			 )
	    (MiddleSelection LatticeBrowser.MiddleSelection doc 

          (* This function called from the GRAPHER package when a node is selected with the middle mouse button.
	  If no node is selected then just returns.)

)
	    (MiddleShiftSelect LatticeBrowser.MiddleShiftSelect args (object objname)
			       doc                           (* Called when item is selected with middle key and 
							     LSHIFT is down)
			       )
	    (ObjNamePair LatticeBrowser.ObjNamePair args (objOrName)
			 doc                                 (* Make a pair (object . objName) where objName is label
							     to be used in browser)
			 )
	    (Recompute LatticeBrowser.Recompute args NIL doc 
                                                             (* Recompute the browseGraph in the same window)
		       )
	    (Show LatticeBrowser.Show args (browseList windowOrTitle goodList)
		  doc

          (* * Show the items and their subs on a browse window.)


		  )
	    (TitleFn LatticeBrowser.TitleFn args NIL doc     (*))
	    (Unread LatticeBrowser.Unread args (object objName)
		    doc                                      (* Unread name into system buffer)
		    )
	    (AddRoot LatticeBrowser.AddRoot args (newItem)
		     doc                                     (* Add a named item to the starting list of the browser)
		     )
	    (DeleteRoot LatticeBrowser.DeleteRoot args (deletedItem)
			doc                                  (* Delete a named item from the starting list of the 
							     browser)
			)
	    (SaveInIT LatticeBrowser.SaveInIT args NIL doc 
                                                             (* save value in IT))
	    (ShapeToHold LatticeBrowser.ShapeToHold args NIL))]

[DEFCLASS SupersBrowser
   (MetaClass Class Edited:                                  (* mjs: "22-JUL-83 10:12")
	      doc                                            (* Browses upwards from a class to all of its supers.)
	      )
   (Supers ClassBrowser)
   (ClassVariables)
   (InstanceVariables)
   (Methods (GetSubs SupersBrowser.GetSubs args (object objName)
		     doc                                     (* Returns metaclass plus local supers)
		     ))]

[DEFCLASS MetaBrowser
   (MetaClass Class doc                                      (* Runs through the meta classes of a class)
	      Edited:                                        (* dgb: "22-JUL-83 15:39")
	      )
   (Supers ClassBrowser)
   (ClassVariables)
   (InstanceVariables)
   (Methods (GetSubs MetaBrowser.GetSubs args (elt)
		     doc                                     (* Subs for meta browser is the meta class of the 
							     class.)
		     ))]

[DEFCLASS TextItem
   (MetaClass Class doc                                      (* Simplest structured text object)
	      Edited:                                        (* dgb: "12-OCT-82 23:09")
	      )
   (Supers NamedObject)
   (ClassVariables)
   (InstanceVariables (subs NIL doc                          (* list of other elemetns which are subparts of this 
							     one))
		      (text "" doc                           (* local text for this item)))
   (Methods)]


(RPAQQ BROWSEFNS (BOXNODE BoxWindowNode Browse ClassBrowser.BoxNode ClassBrowser.CVDoc 
			  ClassBrowser.ClassDoc ClassBrowser.CopyTo ClassBrowser.DefineSubclass 
			  ClassBrowser.DeleteClassItem ClassBrowser.DestroyAndRecompute 
			  ClassBrowser.FindWhere ClassBrowser.GetSubs ClassBrowser.IVDoc 
			  ClassBrowser.LeftShiftSelect ClassBrowser.MoveTo ClassBrowser.Recompute 
			  ClassBrowser.RenameClass ClassBrowser.RenamePart ClassBrowser.SetItNew 
			  DoMenuMethod DualMenu DualSelection FindSelectedNode GetMethodArgs 
			  InstanceBrowser.GetSubs InstanceBrowser.NewPath LatticeBrowser.AddRoot 
			  LatticeBrowser.BoxNode LatticeBrowser.ButtonFn LatticeBrowser.DeleteRoot 
			  LatticeBrowser.DoSelectedCommand LatticeBrowser.EEObject 
			  LatticeBrowser.EditObject LatticeBrowser.FlashNode LatticeBrowser.FlipNode 
			  LatticeBrowser.GetLabel LatticeBrowser.GetNodeList LatticeBrowser.GetSubs 
			  LatticeBrowser.HasObject LatticeBrowser.LeftFn LatticeBrowser.LeftSelection 
			  LatticeBrowser.LeftShiftSelect LatticeBrowser.ListObjects 
			  LatticeBrowser.MiddleFn LatticeBrowser.MiddleSelection 
			  LatticeBrowser.MiddleShiftSelect LatticeBrowser.ObjNamePair 
			  LatticeBrowser.Recompute LatticeBrowser.SaveInIT LatticeBrowser.ShapeToHold 
			  LatticeBrowser.Show LatticeBrowser.TitleFn LatticeBrowser.Unread 
			  LatticeBrowser.WhenHeldFn MetaBrowser.GetSubs SupersBrowser.GetSubs 
			  TreeRoots))
(DEFINEQ

(BOXNODE
  [LAMBDA (NODE DS)                                          (* dgb: " 9-DEC-82 17:18")
    (DRAWBOX (LOWER/LEFT/POSITION NODE)
	     (NODEBOXWIDTH NODE)
	     (NODEBOXHEIGHT NODE)
	     1
	     (QUOTE INVERT)
	     DS])

(BoxWindowNode
  [LAMBDA (nodeLabel window)                                 (* dgb: " 3-JUN-83 15:51")

          (* Puts a box around the node with nodeLabel in the graph. A nodeLabel in browsers is an object.
	  Does nothing if node not found.)


    (PROG (node nodes)
          (AND (WINDOWP window)
	       [SETQ nodes (fetch GRAPHNODES of (WINDOWPROP window (QUOTE GRAPH]
	       (SETQ node (FASSOC nodeLabel nodes))
	       (BOXNODE node window])

(Browse
  [LAMBDA (classes title)                                    (* dgb: "30-JAN-83 13:12")
    (←New
      ($ ClassBrowser)
      Show classes title])

(ClassBrowser.BoxNode
  [LAMBDA (self object)                                      (* dgb: " 4-JUN-83 17:07")
                                                             (* Box selected node and unbox previous)
    (←Super
      self BoxNode object T])

(ClassBrowser.CVDoc
  [LAMBDA (self class className)                             (* dgb: "21-JUL-83 15:46")
                                                             (* Show menu of classVariables and give documentation 
							     for each)
    (PROG [choice menu (vbls (← class List!(QUOTE CVS]
          (COND
	    ((NULL vbls)
	      (PROMPT (CHARACTER 7)
		      "
No Class Variables found for " className)))
          (SETQ menu (create MENU
			     ITEMS ← vbls
			     CHANGEOFFSETFLG ← T
			     TITLE ←(CONCAT className " ClassVars")))
      LP  (COND
	    ((NULL (SETQ choice (MENU menu)))
	      (RETURN NIL)))
          (printout PPDefault T T className "::" choice ": " (GetClassValue class choice
									    (QUOTE doc)))
          (GO LP])

(ClassBrowser.ClassDoc
  [LAMBDA (self object objname)                              (* dgb: " 8-DEC-82 17:02")
                                                             (* Print out class documentation if there is any)
    (PROG [(doc (GetClassHere object (QUOTE doc]
          (COND
	    ((NotSetValue doc)
	      (printout PPDefault T objname " has no documentation." T))
	    (T (printout PPDefault T objname ": " doc T])

(ClassBrowser.CopyTo
  [LAMBDA (self object objName)                              (* dgb: "19-SEP-83 13:24")
                                                             (* Ask user whether to copy CVs IVs or Methods and then 
							     find which ones)
    (PROG (name type value items flg)
          (COND
	    ((NULL (@ boxedNode))
	      (PrintStatus (CHARACTER 7)
			   "First Box the node which is target for move.")
	      (RETURN NIL)))
          (OR [SETQ type (MENU (create MENU
				       ITEMS ←(QUOTE (IVS CVS Methods]
	      (RETURN NIL))
      LP  (COND
	    ((NULL (SETQ items (← object List type)))
	      (OR flg (PrintStatus (CHARACTER 7)
				   objName " has no " type))
	      (RETURN)))
          (SETQ flg T)                                       (* So that when last IV is removed, no comment is made)
          (OR [SETQ name (MENU (create MENU
				       CHANGEOFFSETFLG ← T
				       ITEMS ←(SORT items]
	      (RETURN NIL))
          (SELECTQ type
		   (IVS (← object CopyIV name (@ boxedNode)))
		   (CVS (← object CopyCV name (@ boxedNode)))
		   (Methods (← object CopyMethod name (@ boxedNode)
			       name))
		   NIL)
          (PrintStatus type " " name " has been copied to " (@ boxedNode))
          (GO LP])

(ClassBrowser.DefineSubclass
  [LAMBDA (self object objName)                              (* dgb: "20-SEP-83 16:47")
                                                             (* Define a new subclass, giving it a name typed in by 
							     user)
    (PROG (className)
          (COND
	    ((SETQ className (PromptRead "Type in the name of the new class, or NIL for none."))
	      [COND
		((NOT (LITATOM className))
		  (RETURN (PROMPT (CHARACTER 7)
				  className "should be an atom to name a class"]
	      (← object Specialize className)
	      (← self Recompute])

(ClassBrowser.DeleteClassItem
  [LAMBDA (self class className)                             (* dgb: "19-SEP-83 13:26")
                                                             (* Delete an item from a class, or the class itself)
    (PROG (type choice choices)
          (OR [SETQ type (MENU (MenuGetOrCreate ClassChoiceMenu (QUOTE (IVs CVs Methods Class]
	      (RETURN))
          (OR (SETQ choices (← class List type))
	      (PROMPT "
No items for " className " of type " type ".
")
	      (RETURN))
          (AND (EQ type (QUOTE Class))
	       (RETURN (← self DestroyAndRecompute class className)))
          (OR (SETQ choice (MENU (create MENU
					 CHANGEOFFSETFLG ← T
					 ITEMS ← choices)))
	      (RETURN))
          (SELECTQ type
		   (IVs (← class Delete (QUOTE IV)
			   choice))
		   (CVs (← class Delete (QUOTE CV)
			   choice))
		   (Methods (← class Delete (QUOTE Method)
			       choice
			       (PromptRead "Type T <cr>
if function is to be deleted as well: ")))
		   (HELP type " wrong in DeleteClassItem."])

(ClassBrowser.DestroyAndRecompute
  [LAMBDA (self object objName)                              (* dgb: "12-OCT-82 23:40")
                                                             (* Destroy class and recompute lattice.)
    (AND [MENU (create MENU
		       TITLE ←(QUOTE Confirm)
		       ITEMS ←(LIST (CONCAT "Destroy " objName]
	 (PROGN (← object Destroy)
		(← self Recompute])

(ClassBrowser.FindWhere
  [LAMBDA (self object objName)                              (* dgb: "19-SEP-83 13:27")
                                                             (* Ask user whether CVs IVs or Methods wanted and then 
							     find that one)
    (PROG (name type value items menu)
          (OR [SETQ type (MENU (create MENU
				       ITEMS ←(QUOTE (IVS CVS Methods]
	      (RETURN NIL))
          (COND
	    ((NULL (SETQ items (← object List! type)))
	      (PrintStatus (CHARACTER 7)
			   objName " has no " type)
	      (RETURN)))
          (SETQ menu (create MENU
			     CHANGEOFFSETFLG ← T
			     ITEMS ←(SORT items)))
      LP  (OR (SETQ name (MENU menu))
	      (RETURN NIL))
          (SETQ value (← object WhereIs name type))
          (← self FlashNode value)
          (PrintStatus type " " name " is in " value "
")
          (GO LP])

(ClassBrowser.GetSubs
  [LAMBDA (self obj objName)                                 (* dgb: "28-SEP-82 14:36")
                                                             (* Returns subclasses of a class)
    (← obj SubClasses])

(ClassBrowser.IVDoc
  [LAMBDA (self class className)                             (* dgb: "21-JUL-83 15:49")
                                                             (* Show menu of classVariables and give documentation 
							     for each)
    (PROG [choice menu (vbls (← class List!(QUOTE IVS]
          (COND
	    ((NULL vbls)
	      (PROMPT (CHARACTER 7)
		      "
No Instance Variables found for " className)))
          (SETQ menu (create MENU
			     ITEMS ← vbls
			     CHANGEOFFSETFLG ← T
			     TITLE ←(CONCAT className " Instance Vars")))
      LP  (COND
	    ((NULL (SETQ choice (MENU menu)))
	      (RETURN NIL)))
          (printout PPDefault T T className ":" choice ": " (GetClassIV class choice (QUOTE doc)))
          (GO LP])

(ClassBrowser.LeftShiftSelect
  [LAMBDA (self object objname)                              (* dgb: "25-MAR-83 12:15")
                                                             (* Call PrintSummary when selected with LSHIFT down)
    (← object PrintSummary])

(ClassBrowser.MoveTo
  [LAMBDA (self object objName)                              (* dgb: "20-SEP-83 16:52")
                                                             (* mjs: "16-MAR-83 15:06")
                                                             (* Ask user whether to move CVs IVs or Methodsand then 
							     find which ones)
    (PROG (name type value items flg)
          (COND
	    ((NULL (@ boxedNode))
	      (PROMPT (CHARACTER 7)
		      "Use BoxNode to box node which
is to be target for Move or Copy")
	      (RETURN NIL)))
          (OR [SETQ type (MENU (create MENU
				       ITEMS ←(QUOTE (IVS CVS Methods Supers]
	      (RETURN NIL))
      LP  (COND
	    ((NULL (SETQ items (← object List type)))
	      (OR flg (PrintStatus (CHARACTER 7)
				   objName " has no " type))
	      (RETURN)))
          (SETQ flg T)                                       (* So that when last IV is removed, no comment is made)
          (OR [SETQ name (MENU (create MENU
				       CHANGEOFFSETFLG ← T
				       ITEMS ←(COND
					 ((EQ type (QUOTE Supers))
					   items)
					 (T (SORT items]
	      (RETURN NIL))
          (SELECTQ type
		   (Supers                                   (* Substitute the boxed node for the selected super in 
							     the list of items)
			   (← object ReplaceSupers (SUBST (ClassName (@ boxedNode))
							  name items))
			   (← self Recompute)
			   (RETURN))
		   (IVS (MoveVariable objName (ClassName (@ boxedNode))
				      name))
		   (CVS (MoveClassVariable objName (ClassName (@ boxedNode))
					   name))
		   (Methods (MoveMethod objName (ClassName (@ boxedNode))
					name name))
		   NIL)
          (PrintStatus type " " name " is now in " (@ boxedNode))
          (GO LP])

(ClassBrowser.Recompute
  [LAMBDA (self)                                             (* dgb: " 7-JUN-83 15:50")
                                                             (* Recompute graph, and rebox bosedNode)
    (←Super
      self Recompute)
    (AND (%@ boxedNode)
	 (BoxWindowNode (%@ boxedNode)
			(%@ window])

(ClassBrowser.RenameClass
  [LAMBDA (self object objName)                              (* edited: "30-JUN-83 17:52")
                                                             (* Read in a new name for the class, and rename it)
    (RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
	       (PROG (className)
		     (COND
		       ((SETQ className (INTTY "New class name: " NIL 
				    "Type in the new name for this class,
 or NIL not to change."
					       T))
			 (← object Rename className)
			 (← self Recompute])

(ClassBrowser.RenamePart
  [LAMBDA (self object objName)                              (* dgb: "19-SEP-83 13:29")
                                                             (* Ask user whether to rename CVs IVs or Methods or 
							     class and then find which ones)
    (PROG (name newName type value items flg)
          (OR [SETQ type (MENU (create MENU
				       ITEMS ←(QUOTE (IVS CVS Methods Class]
	      (RETURN NIL))
      LP  (SELECTQ type
		   (Class (RETURN (← self RenameClass object objName)))
		   ((IVS CVS Methods))
		   (RETURN NIL))
          (COND
	    ((NULL (SETQ items (← object List type)))
	      (OR flg (PrintStatus (CHARACTER 7)
				   objName " has no " type))
	      (RETURN)))                                     (* So that when last IV is removed, no comment is made)
          (SETQ flg T)
          (OR [SETQ name (MENU (create MENU
				       CHANGEOFFSETFLG ← T
				       ITEMS ←(SORT items]
	      (RETURN NIL))
          (SELECTQ type
		   (IVS (AND (SETQ newName (PromptRead "New IV name:"))
			     (RenameVariable objName name newName)))
		   (CVS (AND (SETQ newName (PromptRead "New CV name:"))
			     (RenameVariable objName name newName T)))
		   (Methods (AND (SETQ newName (PromptRead "New Selector Name:"))
				 (← object RenameMethod name newName)))
		   NIL)
          (GO LP])

(ClassBrowser.SetItNew
  [LAMBDA (self class)                                       (* dgb: "28-SEP-82 16:02")
                                                             (* Set self to instance of selected class)
    (SETTOPVAL (QUOTE IT)
	       (PRINT (← class New)
		      T])

(DoMenuMethod
  [LAMBDA (object items)                                     (* dgb: "28-MAR-83 16:58")
    (PROG [(selector (AND items (MENU (create MENU
					      ITEMS ← items]
          (AND selector (RETURN (←!
				  object selector])

(DualMenu
  [LAMBDA (items whenHeldFn)                                 (* dgb: "29-MAR-83 17:23")
                                                             (* creates and pops up a menu which allows differential 
							     selection on left an middle buttons)
    (MENU (create MENU
		  ITEMS ← items
		  WHENSELECTEDFN ←(QUOTE DualSelection)
		  WHENHELDFN ← whenHeldFn
		  CHANGEOFFSETFLG ← T])

(DualSelection
  [LAMBDA (item menu button)                                 (* dgb: "29-MAR-83 17:57")

          (* A menu WHENSELECTEDFN which allows differential selection on left and middle button. For such differential 
	  selection item should be of form -
	  (itemSeenInMenu (leftValue midValue)) -
	  where midValue can be an atom which is directly returned when item is selected with middle, or midValue can be an 
	  itemList, which will be displayed in a subselection menu)


    (PROG (it it1)
          (RETURN (COND
		    ((NLISTP item)
		      item)
		    ((NLISTP (SETQ it (CADR item)))
		      it)
		    ((EQ (SETQ it1 (CAR it))
			 (QUOTE QUOTE))
		      (CADR it))
		    ((EQ it1 (QUOTE PROGN))
		      (EVAL it))
		    ((EQ button (QUOTE LEFT))
		      (COND
			((LISTP it1)
			  (EVAL it1))
			(T it1)))
		    ((NLISTP (SETQ it1 (CADR it)))
		      it1)
		    (T (DualMenu it1])

(FindSelectedNode
  [LAMBDA (WINDOW)                                           (* dgb: "28-MAR-83 16:54")

          (* Used in BUTTONEVENTFN and gets called whenever cursor moves or button is down. Adapted from APPLYTOSELECTEDNODE
	  in GRAPHER package; returns the selected item rather than applying a function on the inside of the button event 
	  fn.)


    (PROG ([NODELST (fetch (GRAPH GRAPHNODES) of (WINDOWPROP WINDOW (QUOTE GRAPH]
	   (DS (WINDOWPROP WINDOW (QUOTE DSP)))
	   BUTTON OLDPOS REG NOW NEAR)                       (* note which button is down.)
                                                             (* get the region of this window.)
          (SETQ REG (WINDOWPROP WINDOW (QUOTE REGION)))
          (until (LASTMOUSESTATE (OR LEFT MIDDLE)) do (GETMOUSESTATE))
          [SETQ NEAR (NODELST/AS/MENU NODELST (SETQ OLDPOS (CURSORPOSITION NIL DS]
      FLIP(AND NOW (FLIPNODE NOW DS))
          (AND NEAR (FLIPNODE NEAR DS))
          (SETQ NOW NEAR)
      LP                                                     (* wait for a button up or move out of region)
          (GETMOUSESTATE)
          (COND
	    ((NOT (LASTMOUSESTATE (OR LEFT MIDDLE)))         (* button up, process it.)
	      (AND NOW (FLIPNODE NOW DS))                    (* NOW node has been selected.)
	      (RETURN (fetch NODEID of NOW)))
	    ((NOT (INSIDE? (WINDOWPROP WINDOW (QUOTE REGION))
			   LASTMOUSEX LASTMOUSEY))           (* outside of region, return)
	      (AND NOW (FLIPNODE NOW DS))
	      (RETURN))
	    ([EQ NOW (SETQ NEAR (NODELST/AS/MENU NODELST (CURSORPOSITION NIL DS OLDPOS]
	      (GO LP))
	    (T (GO FLIP])

(GetMethodArgs
  [LAMBDA (fn)                                               (* dgb: " 4-JUN-83 17:33")
    (COND
      ([NOT (FMEMB fn (QUOTE (← ←Super ←New SEND]
	NIL)
      (T (PROG (sel meth evalObj obj class arglist (actuals (TTYIN.READ?=ARGS)))
	       (SETQ obj (CAR actuals))                      (* Fix up atoms starting with %@ and %$)
	       (AND (LITATOM obj)
		    (Fix%@%$ obj actuals)
		    (SETQ obj (CAR actuals)))
	       [SETQ evalObj (OR (Object? obj)
				 (AND (EQ (QUOTE %$)
					  (CAR (LISTP obj)))
				      (GetObjectRec (CADR obj]
	       (OR [SETQ class (COND
		       ((EQ fn (QUOTE ←New))
			 evalObj)
		       (T (OR (AND evalObj (Class evalObj))
			      (RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
					 (CLEARW PROMPTWINDOW)
					 (GetClassRec (CAR (INTTYL (CONCAT "Class of " obj 
							      " not known.
Enter name of class: ")
								   NIL "Type in name of class: " T]
		   (RETURN NIL))
	       (OR (SETQ sel (CADR actuals))
		   (AND [SETQ sel (MENU (create MENU
						ITEMS ←(← class List (QUOTE Selectors]
			(BKSYSBUF sel))
		   (RETURN NIL))
	       (COND
		 ((SETQ meth (FetchMethod class sel))
		   (SETQ arglist (ARGLIST meth))
		   (TTYIN.PRINTARGS (QUOTE ←)
				    (CONS (CAR arglist)
					  (CONS (QUOTE Method)
						(CDR arglist)))
				    (CONS obj (CONS meth (CDDR actuals)))
				    0)
		   (RETURN T)))
	       (RETURN NIL])

(InstanceBrowser.GetSubs
  [LAMBDA (self object)                                      (* dgb: "19-SEP-83 17:12")
                                                             (* Gets a set of subs from an object for browsing.)
    (COND
      ((AND (@ subIV)
	    (← object HasIV (@ subIV)))

          (* If the object has an IV named in (@ subIV) and that is an IV of object, then use that for following links)


	(GetValue object (@ subIV])

(InstanceBrowser.NewPath
  [LAMBDA (self subName)                                     (* dgb: "19-SEP-83 17:31")
                                                             (* Changes the name of the sub by which the lattice is 
							     computed, changes the title, and recomputes the graph)
    (PROG NIL
          [COND
	    ((NULL subName)
	      (OR (SETQ subName (PromptRead "Name of new IV for browsing: "))
		  (RETURN]
          (←@
	    subIV subName)
          (←@
	    title
	    (CONCAT subName " instance browser"))
          (AND (← self HasLispWindow)
	       (← self Recompute])

(LatticeBrowser.AddRoot
  [LAMBDA (self newItem)                                     (* dgb: "13-JUN-83 22:16")
                                                             (* Add a named item to the starting list of the browser)
    (PROG ((sl (@ startingList)))
          (OR newItem (SETQ newItem (PromptRead "Give name of item to be added"))
	      (RETURN NIL))
          (OR (LISTP sl)
	      (SETQ sl (LIST sl)))
          (pushnew sl newItem)
          (←@
	    self startingList sl)
          (← self Recompute)
          (← self ShapeToHold])

(LatticeBrowser.BoxNode
  [LAMBDA (self object unboxPrevious)                        (* dgb: " 5-JUN-83 16:49")
                                                             (* Puts a box around the node in the graph representing 
							     the object.)
    (PROG (bn)
          [COND
	    ((LITATOM object)
	      (SETQ object (OR (GetObjectRec object)
			       (ERROR object " is not a named object."]
          (BoxWindowNode object (%@ window))
          (SETQ bn (%@ boxedNode))                           (* Now remember new boxed node)
          (←%@
	    boxedNode
	    (COND
	      ((NULL bn)
		object)
	      ((NEQ bn object)                               (* If there was a previously boxed node, remove the box 
							     from around it)
		(AND unboxPrevious (BoxWindowNode bn (%@ window)))
		object)
	      (T NIL])

(LatticeBrowser.ButtonFn
  [LAMBDA (window)                                           (* dgb: "10-FEB-83 23:50")

          (* * Invoked when a mouse button is depressed in the LatticeBrowser window.)


    (COND
      ((KEYDOWNP (QUOTE CTRL))
	(PROG ((oldMode (DSPOPERATION NIL window)))
	      (GETMOUSESTATE)                                (* Here to move a node.)
	      (DSPOPERATION (QUOTE INVERT)
			    window)
	      (EDITMOVENODE window)
	      (DSPOPERATION oldMode window)))
      ((NULL (INSIDEP (DSPCLIPPINGREGION NIL window)
		      (LASTMOUSEX window)
		      (LASTMOUSEY window)))                  (* In the title region)
	(← (WINDOWPROP window (QUOTE LatticeBrowser))
	   TitleFn))
      (T                                                     (* Here if either button depressed.
							     Invokes either LatticeBrowser.MiddleFn or 
							     LatticeBrowser.LeftFn)
	 (APPLYTOSELECTEDNODE window])

(LatticeBrowser.DeleteRoot
  [LAMBDA (self deletedItem)                                 (* dgb: "20-SEP-83 16:54")
                                                             (* Delete a named item from the starting list of the 
							     browser)
    (PROG ((sl (@ startingList)))
          (SETQ deletedItem (OR deletedItem (@ boxedNode)
				(PromptRead "Give name of item to be deleted")
				(RETURN NIL)))
          (SETQ sl (DREMOVE (GetObjectRec deletedItem)
			    sl))
          (←@
	    self startingList sl)
          (← self Recompute])

(LatticeBrowser.DoSelectedCommand
  [LAMBDA (self command obj objName)                         (* dgb: "28-APR-83 18:40")
                                                             (* does the selected command or forwards it to the 
							     object)
    (PROG (args)
          (COND
	    ((NULL command)
	      (RETURN NIL)))
          [COND
	    ((LISTP command)
	      (SETQ args (CDR command))
	      (SETQ command (CAR command]
          (COND
	    ((AND (NOT (FMEMB command (%@%@ LocalCommands)))
		  (← obj Understands command))
	      (ApplyMethod obj command args))
	    (T (DoMethod self command NIL obj objName args])

(LatticeBrowser.EEObject
  [LAMBDA (self object objName)                              (* dgb: " 2-MAR-83 10:59")
                                                             (* Call editor with EE on object)
    (← object Edit (QUOTE (EE])

(LatticeBrowser.EditObject
  [LAMBDA (self object objName args)                         (* dgb: " 2-MAR-83 10:58")
                                                             (* Call editor with commands args)
    (← object Edit args])

(LatticeBrowser.FlashNode
  [LAMBDA (self node N flashTime)                            (* dgb: "22-NOV-82 23:35")
                                                             (* Flip node N times)
    (for i from 1 to (OR N 3)
       do (← self FlipNode node)
	  (DISMISS (OR flashTime 300))
	  (← self FlipNode node)
	  (DISMISS (OR flashTime 300])

(LatticeBrowser.FlipNode
  [LAMBDA (self object)                                      (* dgb: " 8-FEB-83 16:14")
                                                             (* Inverts the video around the node in the graph 
							     representing the object)
    (PROG (node nodes (window (%@ window)))
          [COND
	    ((LITATOM object)
	      (SETQ object (OR (GetObjectRec object)
			       (ERROR object " is not a named object."]
          [SETQ nodes (fetch GRAPHNODES of (WINDOWPROP window (QUOTE GRAPH]
          (COND
	    ((SETQ node (FASSOC object nodes))
	      (SETTOPVAL (QUOTE IT)
			 object)
	      (FLIPNODE node window))
	    (T (PROMPTPRINT (CONCAT object " is not a node in this browser.
"])

(LatticeBrowser.GetLabel
  [LAMBDA (self object)                                      (* dgb: "26-SEP-82 15:51")
                                                             (* Get a label for an object to be displayed in the 
							     browser.)
    (GetObjectName object])

(LatticeBrowser.GetNodeList
  [LAMBDA (self browseList goodList)                         (* dgb: " 3-JUN-83 14:07")

          (* Compute the node data structures of the tree starting at browseList. If goodList is given, only include 
	  elements of it. If goodList=T make it be browseList.)


    (COND
      ((EQ goodList T)
	(SETQ goodList browseList)))
    (PROG (subs pair (objList (CONS)))

          (* first make objList which is a list of pairs (object . objName). objName will be used as a title for a node in 
	  the browser. This structure will be replaced by a graphNode when it is processed. The nodeID of the graphNode will
	  be the object, and the label will be the name.)


          (for objOrName in browseList do (AND (SETQ pair (← self ObjNamePair objOrName))
					       (NOT (FASSOC (CAR pair)
							    (CAR objList)))
					       (TCONC objList pair)))

          (* * Now MAP ON list so pair can be replaced by graphNode)


          (for pair name obj subObjs on (CAR objList) when (NLISTP (SETQ name (CDAR pair)))
	     do [SETQ subs (← self GetSubs (SETQ obj (CAAR pair]
		(SETQ subObjs (CONS))
		[for sub objPair obj1 in subs
		   do (SETQ objPair (← self ObjNamePair sub))
		      (COND
			((NOT (FASSOC (SETQ obj1 (CAR objPair))
				      (CAR objList)))        (* Collect sub if not already in list)
			  (TCONC objList objPair)))
		      (COND
			((OR (NULL goodList)
			     (FMEMB obj1 goodList)
			     (FMEMB (CDR objPair)
				    goodList))               (* include only members of goodList)
			  (TCONC subObjs obj1]
		(RPLACA pair (create GRAPHNODE
				     NODEID ← obj
				     TONODES ←(CAR subObjs)
				     NODELABEL ← name)))
          (RETURN (CAR objList])

(LatticeBrowser.GetSubs
  [LAMBDA (self object)                                      (* dgb: "26-SEP-82 17:17")
                                                             (* Gets a set of subs from an object for browsing)
    (COND
      ((← object HasIV (QUOTE subs))                         (* If the object has an IV called subs then use the 
							     contents of that)
	(%@ object subs])

(LatticeBrowser.HasObject
  [LAMBDA (self object)                                      (* dgb: "24-NOV-82 10:44")
    (AND [FASSOC (GetObjectRec object)
		 (fetch GRAPHNODES of (WINDOWPROP (%@ window)
						  (QUOTE GRAPH]
	 T])

(LatticeBrowser.LeftFn
  [LAMBDA (graphNode window)                                 (* dgb: "19-SEP-83 13:31")

          (* This function called from the GRAPHER package when a node is selected with the middle mouse button.
	  If no node is selected then just returns.)


    (PROG [objName object selection (latticeBrowser (WINDOWPROP window (QUOTE LatticeBrowser]
          (DECLARE (SPECVARS object latticeBrowser))
          (COND
	    ((NULL graphNode)
	      (RETURN)))
          (SETQ objName (fetch NODELABEL of graphNode))
          (←@
	    latticeBrowser lastSelectedObject (SETQ object (fetch NODEID of graphNode)))
          (GETMOUSESTATE)
          (FLIPNODE graphNode window)
          (COND
	    ((KEYDOWNP (QUOTE LSHIFT))
	      (FLIPNODE graphNode window)
	      (← latticeBrowser LeftShiftSelect object objName))
	    (T [SETQ selection (MENU (create MENU
					     CHANGEOFFSETFLG ← T
					     ITEMS ←(@@ latticeBrowser LeftButtonItems)
					     WHENHELDFN ←(QUOTE LatticeBrowser.WhenHeldFn]
	       (FLIPNODE graphNode window)
	       (← latticeBrowser DoSelectedCommand selection object objName])

(LatticeBrowser.LeftSelection
  [LAMBDA (self)                                             (* dgb: "29-MAR-83 17:10")

          (* * Move object if CTRL down. Do LeftShiftSelect if SHIFT down. Else choose from LeftButtonItems)


    (PROG (oldMode (window (%@ window)))
          (COND
	    ((KEYDOWNP (QUOTE CTRL))
	      (SETQ oldMode (DSPOPERATION NIL window))
	      (GETMOUSESTATE)                                (* Here to move a node.)
	      (DSPOPERATION (QUOTE INVERT)
			    window)
	      (EDITMOVENODE window)
	      (DSPOPERATION oldMode window))
	    (T                                               (* Here if left button depressed but not control.)
	       (PROG (selector items objName (latticeBrowser self)
			       (object (FindSelectedNode window)))
		     (DECLARE (SPECVARS object latticeBrowser))
                                                             (* SPECVARS for whenHeldFn)
		     (OR object (RETURN NIL))                (* Don't do anything unless an object selected)
		     (GETMOUSESTATE)
		     (← self FlipNode object)
		     (SETQ objName (GetObjectName object))
		     (COND
		       ((KEYDOWNP (QUOTE LSHIFT))
			 (← self FlipNode object)
			 (← latticeBrowser LeftShiftSelect object objName))
		       (T (SETQ selector (DualMenu (OR (%@%@ latticeBrowser LeftButtonItems)
						       (RETURN NIL))
						   (QUOTE LatticeBrowser.WhenHeldFn)))
			  (← self FlipNode object)
			  (← latticeBrowser DoSelectedCommand selector object objName])

(LatticeBrowser.LeftShiftSelect
  [LAMBDA (self object objname)                              (* dgb: "28-SEP-82 11:31")
                                                             (* Called when item is selected with left key and LSHIFT
							     is down)
    (← object PP!])

(LatticeBrowser.ListObjects
  [LAMBDA (self object)                                      (* dgb: "24-NOV-82 10:47")
                                                             (* return a list of the objects that are being displayed
							     in the browser)
    (AND (for node in (fetch GRAPHNODES of (WINDOWPROP (%@ window)
						       (QUOTE GRAPH)))
	    collect (CAR node])

(LatticeBrowser.MiddleFn
  [LAMBDA (graphNode window)                                 (* dgb: "19-SEP-83 13:32")

          (* This function called from the GRAPHER package when a node is selected with the middle mouse button.
	  If no node is selected then just returns.)


    (PROG [objName object selection (latticeBrowser (WINDOWPROP window (QUOTE LatticeBrowser]
          (DECLARE (SPECVARS object latticeBrowser))
          (COND
	    ((NULL graphNode)
	      (RETURN)))
          (SETQ objName (fetch NODELABEL of graphNode))
          (←@
	    latticeBrowser lastSelectedObject (SETQ object (fetch NODEID of graphNode)))
          (GETMOUSESTATE)
          (FLIPNODE graphNode window)
          (COND
	    ((KEYDOWNP (QUOTE LSHIFT))                       (* Invoke editor if Left Shift Key is down)
	      (FLIPNODE graphNode window)
	      (ApplyMethodInTtyProcess latticeBrowser (QUOTE MiddleShiftSelect)
				       (LIST object objName)))
	    (T [SETQ selection (MENU (create MENU
					     CHANGEOFFSETFLG ← T
					     ITEMS ←(@@ latticeBrowser MiddleButtonItems)
					     WHENHELDFN ←(QUOTE LatticeBrowser.WhenHeldFn]
	       (FLIPNODE graphNode window)
	       (ApplyMethodInTtyProcess latticeBrowser (QUOTE DoSelectedCommand)
					(LIST selection object objName])

(LatticeBrowser.MiddleSelection
  [LAMBDA (self)                                             (* dgb: "29-MAR-83 17:20")

          (* This function called from the GRAPHER package when a node is selected with the middle mouse button.
	  If no node is selected then just returns.)


    (PROG (objName selection object (window (%@ window))
		   (latticeBrowser self))
          (DECLARE (SPECVARS object latticeBrowser))
          (COND
	    ((NULL (SETQ object (FindSelectedNode window)))
	      (RETURN)))
          (SETQ objName (GetObjectName object))
          (←%@
	    latticeBrowser lastSelectedObject object)
          (GETMOUSESTATE)
          (← self FlipNode object)
          (COND
	    ((KEYDOWNP (QUOTE LSHIFT))                       (* Invoke editor if Left Shift Key is down)
	      (← self FlipNode object)
	      (ApplyMethodInTtyProcess latticeBrowser (QUOTE MiddleShiftSelect)
				       (LIST object objName)))
	    (T (SETQ selection (DualMenu (OR (%@%@ latticeBrowser MiddleButtonItems)
					     (RETURN NIL))
					 (QUOTE LatticeBrowser.WhenHeldFn)))
	       (← self FlipNode object)
	       (ApplyMethodInTtyProcess latticeBrowser (QUOTE DoSelectedCommand)
					(LIST selection object objName])

(LatticeBrowser.MiddleShiftSelect
  [LAMBDA (self object objname)                              (* dgb: "13-JUN-83 20:41")
                                                             (* Called when item is selected with middle key and 
							     LSHIFT is down)
    (← self EditObject object])

(LatticeBrowser.ObjNamePair
  [LAMBDA (self objOrName)                                   (* dgb: " 3-JUN-83 12:59")
                                                             (* Make a pair (object . objName) where objName is label
							     to be used in browser)
    (PROG (obj)
          (COND
	    ((LITATOM objOrName)                             (* assume this is the name of the object.
							     RETURN NIL if it is not.)
	      (OR (SETQ obj (GetObjectRec objOrName))
		  (RETURN NIL))
	      (RETURN (CONS obj objOrName)))
	    (T                                               (* Assume it is an object)
	       (RETURN (CONS objOrName (← self GetLabel objOrName])

(LatticeBrowser.Recompute
  [LAMBDA (self)                                             (* dgb: "13-JUN-83 22:18")
                                                             (* Recompute the browseGraph in the same window)
    (← self Show (@ startingList)
       (@ window))
    (← self ShapeToHold)
    self])

(LatticeBrowser.SaveInIT
  [LAMBDA (self)                                             (* dgb: " 4-JUN-83 17:51")
                                                             (* save value in IT)
    (SETTOPVAL (QUOTE IT)
	       self])

(LatticeBrowser.ShapeToHold
  [LAMBDA (self)                                             (* dgb: "13-JUN-83 22:19")
    (PROG [left bottom right top (region (WINDOWPROP (@ window)
						     (QUOTE REGION)))
		(nodes (fetch GRAPHNODES of (WINDOWPROP (@ window)
							(QUOTE GRAPH]
          (SETQ left (MIN/LEFT nodes))
          (SETQ bottom (MIN/BOTTOM nodes))
          (SETQ right (MAX/RIGHT nodes))
          (SETQ top (MAX/TOP nodes))
          (SHAPEW (@ window)
		  (create REGION
			  LEFT ←(fetch LEFT of region)
			  BOTTOM ←(fetch BOTTOM of region)
			  WIDTH ←(WIDTHIFWINDOW (IMIN MaxLatticeWidth (IDIFFERENCE right left))
						4)
			  HEIGHT ←(HEIGHTIFWINDOW (IMIN MaxLatticeHeight (IDIFFERENCE top bottom))
						  T 4)))
          (SCROLLW (@ window)
		   (WTODSX 0 (@ window))
		   (WTODSY 0 (@ window])

(LatticeBrowser.Show
  [LAMBDA (self browseList windowOrTitle goodList)           (* dgb: "20-SEP-83 16:04")

          (* * Show the items and their subs on a browse window.)



          (* * If windowOrTitle is not a window it will be used as a title for a window which will be created.)


    (PROG (NODELST roots window)
          (←@
	    startingList
	    (MAPCAR (COND
		      ((NOT (LISTP browseList))
			(SETQ browseList (LIST browseList)))
		      (T browseList))
		    (FUNCTION GetObjectRec)))
          (COND
	    ((AND windowOrTitle (NOT (WINDOWP windowOrTitle)))
	      (←@
		title windowOrTitle)))
          (SETQ NODELST (← self GetNodeList browseList goodList))
          (SETQ window (SHOWGRAPH (LAYOUTLATTICE NODELST (SETQ roots (TreeRoots NODELST))
						 NIL
						 (@ browseFont))
				  (OR (@ window)
				      windowOrTitle
				      (@ title))
				  NIL NIL (@ topAlign)))
          (WINDOWPROP window (QUOTE BUTTONEVENTFN)
		      (QUOTE WindowButtonEventFn))
          (WINDOWPROP window (QUOTE LoopsWindow)
		      self)
          (←@
	    window window)
          (RETURN window])

(LatticeBrowser.TitleFn
  [LAMBDA (self)                                             (* dgb: "28-MAR-83 17:51")
                                                             (*)
    (← self DoSelectedCommand (MENU (create MENU
					    ITEMS ←(%@%@ TitleItems])

(LatticeBrowser.Unread
  [LAMBDA (self object objName)                              (* dgb: "28-SEP-82 15:14")
                                                             (* Unread name into system buffer)
    (BKSYSBUF (CONCAT "$" objName])

(LatticeBrowser.WhenHeldFn
  [LAMBDA (item menu key)                                    (* dgb: "30-SEP-82 08:22")

          (* Prints documentation for the method, either from the item list of from the class of object or latticeBrowser, 
	  bound above in LatticeBrowser.LeftFn or LatticeBrowser.MiddleFn)


    (DECLARE (SPECVARS object latticeBrowser))
    (PROMPTPRINT (COND
		   [(LITATOM item)                           (* Get method documentation from object or browser)
		     (COND
		       ((← object Understands item)
			 (GetMethod (Class object)
				    item
				    (QUOTE doc)))
		       (T (GetMethod (Class latticeBrowser)
				     item
				     (QUOTE doc]
		   ((AND (LISTP item)
			 (CDDR item))
		     (CADDR item))
		   (T "When released this item will be selected"])

(MetaBrowser.GetSubs
  [LAMBDA (self elt)                                         (* dgb: "22-JUL-83 15:38")
                                                             (* Subs for meta browser is the meta class of the 
							     class.)
    (PROG [(meta (GetObjectRec (CAR (← (GetObjectRec elt)
				       List
				       (QUOTE Meta]
          (RETURN (COND
		    ((EQ meta (GetObjectRec elt))
		      NIL)
		    (T (CONS meta])

(SupersBrowser.GetSubs
  [LAMBDA (self object objName)                              (* dgb: "28-MAR-83 11:53")
                                                             (* Returns local supers)
    (Supers object])

(TreeRoots
  [LAMBDA (nodeLst)                                          (* dgb: "12-OCT-82 22:56")
                                                             (* Computes the set of root nodes for a lattice -- those
							     with no connections TO them in list of nodes.)
    (for ND in nodeLst bind (ROOTLST ←(MAPCAR nodeLst (FUNCTION CAR)))
       do (for D in (TOLINKS ND) do (DREMOVE D ROOTLST)) finally (RETURN ROOTLST])
)

(RPAQQ MaxLatticeHeight 750)

(RPAQQ MaxLatticeWidth 900)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (16869 54936 (BOXNODE 16879 . 17116) (BoxWindowNode 17118 . 17599) (Browse 17601 . 17764
) (ClassBrowser.BoxNode 17766 . 18031) (ClassBrowser.CVDoc 18033 . 18818) (ClassBrowser.ClassDoc 18820
 . 19267) (ClassBrowser.CopyTo 19269 . 20546) (ClassBrowser.DefineSubclass 20548 . 21138) (
ClassBrowser.DeleteClassItem 21140 . 22193) (ClassBrowser.DestroyAndRecompute 22195 . 22594) (
ClassBrowser.FindWhere 22596 . 23484) (ClassBrowser.GetSubs 23486 . 23726) (ClassBrowser.IVDoc 23728
 . 24503) (ClassBrowser.LeftShiftSelect 24505 . 24777) (ClassBrowser.MoveTo 24779 . 26553) (
ClassBrowser.Recompute 26555 . 26890) (ClassBrowser.RenameClass 26892 . 27418) (
ClassBrowser.RenamePart 27420 . 28781) (ClassBrowser.SetItNew 28783 . 29076) (DoMenuMethod 29078 . 
29328) (DualMenu 29330 . 29751) (DualSelection 29753 . 30684) (FindSelectedNode 30686 . 32378) (
GetMethodArgs 32380 . 33779) (InstanceBrowser.GetSubs 33781 . 34239) (InstanceBrowser.NewPath 34241 . 
34856) (LatticeBrowser.AddRoot 34858 . 35426) (LatticeBrowser.BoxNode 35428 . 36294) (
LatticeBrowser.ButtonFn 36296 . 37246) (LatticeBrowser.DeleteRoot 37248 . 37814) (
LatticeBrowser.DoSelectedCommand 37816 . 38464) (LatticeBrowser.EEObject 38466 . 38717) (
LatticeBrowser.EditObject 38719 . 38967) (LatticeBrowser.FlashNode 38969 . 39346) (
LatticeBrowser.FlipNode 39348 . 40090) (LatticeBrowser.GetLabel 40092 . 40384) (
LatticeBrowser.GetNodeList 40386 . 42177) (LatticeBrowser.GetSubs 42179 . 42595) (
LatticeBrowser.HasObject 42597 . 42841) (LatticeBrowser.LeftFn 42843 . 44005) (
LatticeBrowser.LeftSelection 44007 . 45534) (LatticeBrowser.LeftShiftSelect 45536 . 45830) (
LatticeBrowser.ListObjects 45832 . 46250) (LatticeBrowser.MiddleFn 46252 . 47579) (
LatticeBrowser.MiddleSelection 47581 . 48833) (LatticeBrowser.MiddleShiftSelect 48835 . 49146) (
LatticeBrowser.ObjNamePair 49148 . 49855) (LatticeBrowser.Recompute 49857 . 50181) (
LatticeBrowser.SaveInIT 50183 . 50430) (LatticeBrowser.ShapeToHold 50432 . 51290) (LatticeBrowser.Show
 51292 . 52423) (LatticeBrowser.TitleFn 52425 . 52701) (LatticeBrowser.Unread 52703 . 52957) (
LatticeBrowser.WhenHeldFn 52959 . 53773) (MetaBrowser.GetSubs 53775 . 54224) (SupersBrowser.GetSubs 
54226 . 54455) (TreeRoots 54457 . 54934)))))
STOP