(FILECREATED "15-Aug-86 15:43:33" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH089.;2 8495
changes to: (VARS RHTPATCH089COMS)
(FNS NC.MakeDocument)
previous date: "15-Aug-86 14:24:48" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH089.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH089COMS)
(RPAQQ RHTPATCH089COMS ((FNS NC.MakeDocument)
(FNS NC.RelayoutGraphCard)))
(DEFINEQ
(NC.MakeDocument
(LAMBDA (Card Title NoDisplayFlg CardIdentifier) (* rht: "15-Aug-86 15:41")
(* * Called from a filebox's title bar. Makes a document by smashing all the descendant cards's text together.
Ask user if wants numbered section headings and titles. The former are made from FileBox titles, the latter from
notecard titles. Delete embedded links at the end if the user desires.)
(* * rht 10/22/84: Hacked to be callable from Programmer's interface.)
(* * rht 11/17/84: Checks for cancel when choosing rootID and also when setting parameters.)
(* * rht 8/25/85: Now dumps sketch and graph cards as well as text cards.)
(* * rht 9/16/85: Now handles cr's around titles using para leading.)
(* * fgh 11/178/85 Updated to handle Card and NoteFile objects.)
(* * kirk 27Jun86 Moved NC.RetrieveTitle call so does not break when user Cancels)
(* * rht 7/31/86: Now checks for card types having ExportSubstanceFn prop.)
(* * rht 8/15/86: Changed from NC.MakeTextCard to NC.ApplySupersFn.)
(PROG (RootCard RootTitle DocWindow DocCard DocWindowOrCard DocStream HeadingsFromFileboxes
TitlesFromNoteCards BuildBackLinks CopyEmbeddedLinks ExpandEmbeddedLinks
InspectWin WasActive RootType RootSubstanceType)
(OR NoDisplayFlg (SPAWN.MOUSE))
(SETQ DocWindowOrCard (NC.ApplySupersFn MakeFn Card (OR Title "Document")
NoDisplayFlg))
(if NoDisplayFlg
then (SETQ DocWindow NIL)
(SETQ DocCard DocWindowOrCard)
else (SETQ DocWindow DocWindowOrCard)
(SETQ DocCard (NC.CoerceToCard DocWindow)))
(* NC.MakeNoteCard either returned an Card or a window
depending on NoDisplayFlg.)
(SETQ RootCard (OR (NC.CoerceToCard CardIdentifier)
(NC.SelectNoteCards T NIL NC.SelectingCardMenu DocWindow NIL
"Please select the Note Card or File Box the document should start from.")))
(if (NOT RootCard)
then (NC.DeleteNoteCards Card T)
(RETURN NIL))
(SETQ RootTitle (NC.RetrieveTitle RootCard))
(NC.SetTitle DocCard (CONCAT "Document from %"" RootTitle "%""))
(AND DocWindow (WINDOWPROP DocWindow (QUOTE TITLE)
(NC.RetrieveTitle DocCard)))
(SETQ DocStream (NC.FetchSubstance DocCard))
(* * Get MakeDocument parameters from user via inspector window.)
(if (NOT NoDisplayFlg)
then (SETQ InspectWin (NC.BuildMakeDocInspector DocWindow))
(TOTOPW InspectWin)
(for while (OPENWP InspectWin) do (BLOCK)))
(if (EQ (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE --DONE--))
(QUOTE QUIT))
then (PUTPROP (QUOTE NC.MakeDocParameters)
(QUOTE --DONE--)
(QUOTE --CANCEL--))
(NC.DeleteNoteCards Card T)
(RETURN NIL))
(SETQ HeadingsFromFileboxes (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE HeadingsFromFileboxes)))
(SETQ TitlesFromNoteCards (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE TitlesFromNoteCards)))
(SETQ BuildBackLinks (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE BuildBackLinks)))
(SETQ CopyEmbeddedLinks (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE CopyEmbeddedLinks)))
(SETQ ExpandEmbeddedLinks (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE ExpandEmbeddedLinks)))
(* * Call recursive routine to dump filebox.)
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(NC.PrintMsg DocWindow NIL "Collecting text from descendant cards ... ")
(* * Clean up the SeenBefore markers placed on the cards and boxes just copied.)
(RESETSAVE NIL (QUOTE (PROGN (for Card in (NC.FetchUserDataProp
DocCard
(QUOTE SeenCards))
do (NC.SetUserDataProp
Card
(QUOTE SeenBefore)
NIL))
(NC.SetUserDataProp DocCard
(QUOTE SeenCards)
NIL))))
(* * Unbelievably kludgy hack to get around Intermezzo TEdit bug. Just insert and delete a CR.)
(TEDIT.INSERT DocStream NC.CRString 1)
(TEDIT.DELETE DocStream 1 1)
(OR (SETQ WasActive (NC.ActiveCardP RootCard))
(NC.GetNoteCard RootCard))
(SETQ RootType (NC.RetrieveType RootCard))
(if (EQ RootType (QUOTE FileBox))
then (NC.DumpFileBoxToDoc RootCard DocCard DocStream ""
HeadingsFromFileboxes TitlesFromNoteCards
BuildBackLinks CopyEmbeddedLinks
ExpandEmbeddedLinks)
else (COND
((NC.TEditBasedP RootType)
(NC.DumpNoteCardToDoc RootCard DocCard DocStream "" 1
HeadingsFromFileboxes
TitlesFromNoteCards BuildBackLinks
CopyEmbeddedLinks ExpandEmbeddedLinks))
((OR (NCP.SketchBasedP RootType)
(NCP.GraphBasedP RootType)
(GETPROP RootType (QUOTE ExportSubstanceFn)))
(NC.DumpExportableCardToDoc RootCard DocCard DocStream "" 1
HeadingsFromFileboxes
TitlesFromNoteCards BuildBackLinks
CopyEmbeddedLinks
ExpandEmbeddedLinks RootType))
(T (NC.PrintMsg NIL NIL
"Can't make document from non-exportable card "
(NC.RetrieveTitle RootCard)
(CHARACTER 13)))))
(OR WasActive (NC.DeactivateCard RootCard))
(NC.PrintMsg DocWindow NIL "Done!"))
(COND
((NOT NoDisplayFlg)
(BLOCK 250)
(NC.ClearMsg DocWindow T)))
(RETURN DocWindowOrCard))))
)
(DEFINEQ
(NC.RelayoutGraphCard
(LAMBDA (Win) (* rht: "15-Aug-86 14:16")
(* * Relayout the graph by making roots out of all nodes without FROMNODES.)
(* * rht 8/15/86: Now uses proper COPYBUTTONEVENTFN in the SHOWGRAPH call.)
(LET ((Graph (WINDOWPROP Win (QUOTE GRAPH)))
GraphNodes)
(if (SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of Graph))
then (SETQ Graph (LAYOUTGRAPH GraphNodes (OR (for Node in GraphNodes
when
(NULL (fetch (GRAPHNODE
FROMNODES)
of Node))
collect (fetch (GRAPHNODE
NODEID)
of Node))
(fetch (GRAPHNODE NODEID)
of (CAR GraphNodes)))
(QUOTE Lattice)))
(replace (GRAPH GRAPH.ADDNODEFN) of Graph with (FUNCTION
NC.GraphAddNodeFn))
(replace (GRAPH GRAPH.DELETENODEFN) of Graph with (FUNCTION
NC.GraphDeleteNodeFn))
(replace (GRAPH GRAPH.ADDLINKFN) of Graph with (FUNCTION
NC.GraphAddLinkFn))
(replace (GRAPH GRAPH.DELETELINKFN) of Graph with (FUNCTION
NC.GraphDeleteLinkFn))
(replace (GRAPH GRAPH.MOVENODEFN) of Graph with (FUNCTION
NC.GraphMoveNodeFn))
(replace (GRAPH GRAPH.FONTCHANGEFN) of Graph with (FUNCTION
NC.GraphFontChangeFn))
(SHOWGRAPH Graph Win (FUNCTION NC.GraphCardLeftButtonFn)
(FUNCTION NC.GraphCardMiddleButtonFn)
NIL T (FUNCTION NC.GRAPHERCOPYBUTTONEVENTFN))
(NC.InstallTitleBarButtonEventFn Win (FUNCTION NC.GraphTitleBarButtonEventFn))
))))
)
(PUTPROPS RHTPATCH089 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (429 6542 (NC.MakeDocument 439 . 6540)) (6543 8413 (NC.RelayoutGraphCard 6553 . 8411))))
)
STOP