(FILECREATED "12-Feb-85 03:08:37" {PHYLUM}<NOTECARDS>RELEASE1.2>RHTPATCH001.;1
 10653  

      changes to:  (VARS RHTPATCH001COMS)
		   (FNS DEMO.ReshapeWins))


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT RHTPATCH001COMS)

(RPAQQ RHTPATCH001COMS
 ((FNS NC.MakeBrowserCard NCP.CreateBrowserCard NC.BringUpTEditCard)
			(FNS DEMO.ReshapeWins)))
(DEFINEQ

(NC.MakeBrowserCard

  (LAMBDA (ID Title NoDisplayFlg ListOfRootIDAndListOfLinkLabelsAndVerticalFlg)
                                                             (* rht: "11-Feb-85 23:36")


          (* Make a browser card with id ID using root at RootID and the link following predictae specified by Predicate.

	  IF Root and/or ListOfLinkLabels not specified, ask the user.)




          (* * rht 8/3/84: Changed to call NC.AskLinkLabel with its ReverseLinkLabel parameter set to T.)




          (* * fgh 10/2/84 Changed Link Icons to be image objects in NodeLabel of Graph Npodes rather than annotations on 

	  graph nodes.)




          (* * rht 10/19/84: Fixed setting up of browser card's prop list in case NoDisplayFlg is T so we have no Window.

	  Now NC.MakeLinksLegend returns the label pairs.)




          (* * rht 11/27/84: Removed the WINDOWADDPROP call to put NC.GraphCardCloseFn on the CLOSEFN of the window.

	  This causes trouble. NC.QuitCard will get put on by NC.MakeNoteCard and that's enough.)




          (* * rht 1/3/85: Now puts a dummy region of the right size if the NoDisplayFlg is on.)



    (
PROG
 (Lattice Window Graph PropList BrowserSpecs (RootID (
CAR
 
						    ListOfRootIDAndListOfLinkLabelsAndVerticalFlg))
		   (ListOfLinkLabels (
CADR
 ListOfRootIDAndListOfLinkLabelsAndVerticalFlg))
		   (VerticalFlg (
CADDR
 ListOfRootIDAndListOfLinkLabelsAndVerticalFlg))
		   LabelPairs)
          (
NC.ActivateCard
 ID)
          (if
 NoDisplayFlg
	      then
 (
NC.SetRegion
 ID (
NC.MakeDummyRegion
 (
QUOTE
 Browser)))
	    else
 (
SETQ
 Window (
CREATEW
 (
GETBOXREGION
 NC.BrowserCardDefaultWidth 
						     NC.BrowserCardDefaultHeight (
GETMOUSEX
)
						     (
IDIFFERENCE
 (
GETMOUSEY
)
								  NC.BrowserCardDefaultHeight)
						     NIL 
					   "Please indicate where to place the new browser card.")
				       (
NC.FetchTitle
 ID)
				       NIL)))
          (
SETQ
 RootID (
OR
 RootID (
PROGN
 (
NC.PrintMsg
 Window T 
			 "Please select the Note Card or File Box the browser should start from."
						      (
CHARACTER
 13))
					 (
NC.SelectNoteCards
 T NIL NC.SelectingBrowserSourceMenu 
							     Window))))
          (
COND

	    ((
NULL
 RootID)
	      (
NC.DeactivateCard
 ID)
	      (
CLOSEW
 Window)
	      (
RETURN
)))
          (
OR
 ListOfLinkLabels (
SETQ
 ListOfLinkLabels (
NC.AskLinkLabel
 Window T T NIL NIL T))
	      (
PROGN
 (
NC.PrintMsg
 Window T "Defaulting to SubBox pointers." (
CHARACTER
 13))
		     (
SETQ
 ListOfLinkLabels NC.SubBoxLinkLabel)))
          (
SETQ
 BrowserSpecs (
COND

	      (NC.SpecialBrowserSpecsFlg (
NC.AskBrowserSpecs
 Window))
	      (T (create
 BrowserSpecs))))
          (if
 VerticalFlg
	      then
 (replace
 (BrowserSpecs Format) of
 BrowserSpecs with
 (
QUOTE
 (LATTICE VERTICAL))))
          (
OR
 NoDisplayFlg (
NC.PrintMsg
 Window NIL (
CHARACTER
 13)
					"Computing browser graph. Please wait. ..."))
          (
SETQ
 Lattice (
CDR
 (
NC.GrowLinkLattice
 RootID (
LIST
 NIL)
						 ListOfLinkLabels ID PSA.Database)))
          (
SETQ
 LabelPairs (
NC.MakeLinksLegend
 Lattice Window))
          (
OR
 NoDisplayFlg (
WINDOWPROP
 Window (
QUOTE
 NoteCardID)
				       ID))

          (* * Link destination id information stored in NodeLabel field into a LinkIcon for display)



          (for
 Node in
 Lattice do
 (replace
 (GRAPHNODE NODELABEL) of
 Node
				     with
 (
NC.MakeLinkIcon
 (
NC.MakeLink
 Window 
								      NC.BrowserContentsLinkLabel
									(fetch
 (GRAPHNODE NODELABEL)
									   of
 Node)
									ID NIL))))
          (
SETQ
 Graph (
LAYOUTGRAPH
 Lattice (
LIST
 (
CAAR
 Lattice))
				   (fetch
 (BrowserSpecs Format) of
 BrowserSpecs)
				   (fetch
 (BrowserSpecs Font) of
 BrowserSpecs)
				   (fetch
 (BrowserSpecs MotherD) of
 BrowserSpecs)
				   (fetch
 (BrowserSpecs PersonalD) of
 BrowserSpecs)
				   (fetch
 (BrowserSpecs FamilyD) of
 BrowserSpecs)))
          (
OR
 NoDisplayFlg (
NC.PrintMsg
 Window NIL "Done!"))
          (
NC.SetSubstance
 ID Graph)
          (
SETQ
 PropList (
NC.FetchPropList
 ID))
          (
COND

	    (PropList (
LISTPUT
 PropList (
QUOTE
 BrowserLinkLabels)
			       (
LIST
 (
OR
 ListOfLinkLabels NC.SubBoxLinkLabel))))
	    (T (
NC.SetPropList
 ID (
SETQ
 PropList (
LIST
 (
QUOTE
 BrowserLinkLabels)
						       (
LIST
 (
OR
 ListOfLinkLabels NC.SubBoxLinkLabel))
						       )))))
          (
LISTPUT
 PropList (
QUOTE
 BrowserRoot)
		   RootID)
          (
LISTPUT
 PropList (
QUOTE
 BrowserLinksLegend)
		   LabelPairs)
          (
AND
 NC.SpecialBrowserSpecsFlg (
LISTPUT
 PropList (
QUOTE
 BrowserSpecs)
						  (
LIST
 BrowserSpecs)))
          (
NC.SetPropListDirtyFlg
 ID T)
          (
COND

	    (NoDisplayFlg (
RETURN
 ID)))
          (replace
 (GRAPH GRAPH.ADDNODEFN) of
 Graph with
 (
FUNCTION
 NC.GraphAddNodeFn))
          (
SHOWGRAPH
 Graph Window (
FUNCTION
 NC.GraphCardLeftButtonFn)
		     (
FUNCTION
 NC.GraphCardMiddleButtonFn)
		     NIL T)
          (
NC.SetupTitleBarMenu
 Window ID (
QUOTE
 Browser))
          (
NC.ClearMsg
 Window T)
          (
RETURN
 Window))))

(NCP.CreateBrowserCard

  (LAMBDA (Title RootID LinkLabels NoDisplayFlg Props ParentFileBoxes VerticalFlg)
                                                             (* rht: "11-Feb-85 23:40")


          (* * Creates a new browser notecard with given type, title, props, parents, starting ID and link labels.

	  LinkLabels can be atom or list and can contain litatoms ALL and/or _ALL.)



    (
PROG
 (ValidLinkLabels)
          (
SETQ
 ValidLinkLabels (for
 Label in
 (
MKLIST
 LinkLabels) join
 (
COND

									 ((
EQ
 Label (
QUOTE
 ALL))
									   (
NCP.GetLinkLabels
))
									 ((
EQ
 Label (
QUOTE
 _ALL))
									   (
NCP.GetReverseLinkLabels
))
									 ((
NOT
 (
NCP.ValidLinkLabel

										 Label))
									   (
NCP.ReportError
 Label 
								       " not a valid link label.")
									   NIL)
									 (T (
LIST
 Label)))))
          (
SETQ
 ValidLinkLabels (
INTERSECTION
 ValidLinkLabels ValidLinkLabels))
          (
RETURN
 (if
 (
AND
 LinkLabels (
NULL
 ValidLinkLabels))
		      then
 NIL
		    else
 (
NCP.CreateCard
 (
QUOTE
 Browser)
					 Title NoDisplayFlg Props ParentFileBoxes
					 (
LIST
 RootID ValidLinkLabels VerticalFlg)))))))

(NC.BringUpTEditCard

  (LAMBDA (ID TextStream Region/Position)                    (* rht: "12-Feb-85 01:49")

                                                             (* Bring up a TEdit window for Card ID whose text 

							     stream is TextStream in Region specified by 

							     Region/Position or by the user.)

    (
PROG
 (Region TEditWindow TEditProcess Title)
          (
COND

	    ((
AND
 (
SETQ
 TEditWindow (fetch
 (
TEXTOBJ
 \WINDOW) of
 (
TEXTOBJ
 TextStream)))
		  (
SETQ
 TEditProcess (
WINDOWPROP
 TEditWindow (
QUOTE
 PROCESS))))
	      (
TOTOPW
 TEditWindow)
	      (
RPTQ
 2 (
FLASHW
 TEditWindow))
	      (
TTY.PROCESS
 TEditProcess)
	      (
RETURN
 TEditWindow)))
          (
SETQ
 Region (
COND

	      ((type?
 REGION Region/Position)
		Region/Position)
	      ((
AND
 (
SETQ
 Region (
NC.FetchRegion
 ID))
		    (
POSITIONP
 Region/Position))
		(
CREATEREGION
 (fetch
 XCOORD of
 Region/Position)
			      (fetch
 YCOORD of
 Region/Position)
			      (fetch
 WIDTH of
 Region)
			      (fetch
 HEIGHT of
 Region)))
	      ((
POSITIONP
 Region/Position)
		(
CREATEREGION
 (fetch
 XCOORD of
 Region/Position)
			      (fetch
 YCOORD of
 Region/Position)
			      PSA.TEditCardDefaultWidth PSA.TEditCardDefaultHeight))
	      (T (
COND

		   (Region (
GETBOXREGION
 (fetch
 WIDTH of
 Region)
					 (fetch
 HEIGHT of
 Region)
					 (
GETMOUSEX
)
					 (
IDIFFERENCE
 (
GETMOUSEY
)
						      (fetch
 HEIGHT of
 Region))
					 NIL
					 (
CONCAT
 "Please specify location for edit of Note Card " ID))
			   )
		   (T (
GETBOXREGION
 PSA.TEditCardDefaultWidth PSA.TEditCardDefaultHeight (
GETMOUSEX
)
				    (
IDIFFERENCE
 (
GETMOUSEY
)
						 PSA.TEditCardDefaultHeight)
				    NIL
				    (
CONCAT
 "Please specify location for edit of Note Card " ID)))))))
          (
SETQ
 Title (
NC.FetchTitle
 ID))
          (
SETQ
 TEditWindow (
CREATEW
 Region Title (
NC.DetermineBorderWidth
 (
NC.FetchType
 ID))
				     T))
          (
WINDOWPROP
 TEditWindow (
QUOTE
 SHRINKFN)
		      (
FUNCTION
 NC.ShrinkFn))
          (
WINDOWPROP
 TEditWindow (
QUOTE
 NoteCardsLeftButtonMenu)
		      (
NC.MakeTEditLeftMenu
 (
NC.FetchType
 ID)))
          (
WINDOWPROP
 TEditWindow (
QUOTE
 NoteCardsMiddleButtonMenu)
		      (
NC.MakeTEditMiddleMenu
))
          (
SETQ
 TextStreamDirtyFlg (
TEDIT.STREAMCHANGEDP
 TextStream))
          (
TEDIT
 TextStream TEditWindow NIL (
LIST
 (
QUOTE
 FONT)
						  NC.DefaultFont
						  (
QUOTE
 TITLEMENUFN)
						  (
FUNCTION
 NC.TEditMenuFn)))
          (
AND
 TextStreamDirtyFlg (
NC.MarkCardDirty
 ID))
          (
RETURN
 TEditWindow))))
)
(DEFINEQ

(DEMO.ReshapeWins

  (LAMBDA (WinList StartVal Increment)                       (* rht: "12-Feb-85 03:01")


          (* * For each window in WinList reshape it to be in successively larger shapes starting with 4*StartVal by 

	  3*StartVal and increasing by Increment each time.)



    (for
 Win in
 WinList
       bind
 (CurWidth _(
ITIMES
 StartVal 4))
	    (CurHeight _(
ITIMES
 StartVal 3))
       do
 (
SHAPEW
 Win (create
 REGION copying
 (
WINDOWREGION
 Win)
					     WIDTH _ CurWidth HEIGHT _ CurHeight))
	  (
SETQ
 CurWidth (
IPLUS
 CurWidth (
ITIMES
 4 Increment)))
	  (
SETQ
 CurHeight (
IPLUS
 CurHeight (
ITIMES
 3 Increment))))))
)
(PUTPROPS RHTPATCH001 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (391 9861 (NC.MakeBrowserCard 401 . 5803) (NCP.CreateBrowserCard 5805 . 7052) (
NC.BringUpTEditCard 7054 . 9859)) (9862 10571 (DEMO.ReshapeWins 9872 . 10569)))))
STOP