(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