(FILECREATED "27-Mar-87 14:26:00" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH228.;2 7692
changes to: (VARS RHTPATCH228COMS)
(FNS NC.MakeExternalSketchCopy NC.DumpExportableCardToDoc)
previous date: "26-Mar-87 18:23:55" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH228.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH228COMS)
(RPAQQ RHTPATCH228COMS ((* * Fixes bug #480: Sketch in document card doesn't smash links.)
(DECLARE: FIRST COPY (P (LOAD? (NC.FindFile (QUOTE NCSKETCHCARD)))))
(DECLARE: FIRST COPY (P (LOAD? (NC.FindFile (QUOTE NCDOCUMENTCARD)))))
(* * New function for NCSKETCHCARD)
(FNS NC.MakeExternalSketchCopy)
(* * Change to NCDOCUMENTCARD)
(FNS NC.DumpExportableCardToDoc)))
(* * Fixes bug #480: Sketch in document card doesn't smash links.)
(DECLARE: FIRST COPY
(LOAD? (NC.FindFile (QUOTE NCSKETCHCARD)))
)
(DECLARE: FIRST COPY
(LOAD? (NC.FindFile (QUOTE NCDOCUMENTCARD)))
)
(* * New function for NCSKETCHCARD)
(DEFINEQ
(NC.MakeExternalSketchCopy
(LAMBDA (Sketch) (* rht: "26-Mar-87 18:14")
(* * Make a copy of the sketch smashing any link icons.)
(LET ((SketchCopy (SKETCH.ADD.ELEMENT NIL NIL)))
(SKETCH.COPY.ELEMENTS (SKETCH.ELEMENTS.OF.SKETCH Sketch)
SketchCopy)
(NC.ExternalizeLinkIconsInSketch SketchCopy)
SketchCopy)))
)
(* * Change to NCDOCUMENTCARD)
(DEFINEQ
(NC.DumpExportableCardToDoc
(LAMBDA (Card DocCard DocStream CurSection SubSectionNum HeadingsFromFileboxes TitlesFromNoteCards
BuildBackLinks CopyEmbeddedLinks ExpandEmbeddedLinks CardType)
(* rht: "26-Mar-87 18:21")
(* * Dump the CardID sketch or graph card to the document card DocStream.)
(* * rht 9/16/85: Now handles cr's around titles using para leading.)
(* * fgh 11/17/85 Updated to handle card objects and removal of SubstanceTypes.)
(* * rht 7/31/86: Now can handle other card types than Graph or Sketch based ones, but they must have an
appropriate fn on the ExportSubstanceFn property of the atom. That fn should return either an imageobj or a
textstream.)
(* * rht 8/11/86: Added ShrunkenFlg so that Card is reshrunk afterwards if necessary.)
(* * rht 10/15/86: Integrated markM's changes and fixed box numbering.)
(* * rht 10/31/86: Now uses TEDIT.COPY rather than TEDIT.INCLUDE because the latter loses formatting info.)
(* * rht 3/26/87: Fixed bug whereby links in sketch cards weren't getting smashed to "external" link icons.
Now calls NC.MakeExternalSketchCopy.)
(DECLARE (GLOBALVARS NC.DocBackPtrLinkLabel))
(LET ((CardStream (NC.FetchSubstance Card))
(DocObj (TEXTOBJ DocStream))
ShrunkenFlg OldLoc ThingToInsert)
(NC.AddCRIfNeeded DocStream)
(SETQ OldLoc (fetch (TEXTOBJ TEXTLEN) of DocObj))
(AND (NEQ TitlesFromNoteCards (QUOTE NONE))
(NC.AppendStringToStream DocStream (CONCAT (NC.RetrieveTitle Card))
(EQ TitlesFromNoteCards (QUOTE Bold))))
(AND (FMEMB BuildBackLinks (QUOTE (ToCards ToCardsBoxes)))
(NCP.LocalGlobalLink NC.DocBackPtrLinkLabel DocCard Card (QUOTE END)
(create LINKDISPLAYMODE
ATTACHBITMAPFLG ← T)))
(if (GREATERP (fetch (TEXTOBJ TEXTLEN) of DocObj)
OldLoc)
then (NC.AddCRIfNeeded DocStream)
(NC.ChangeParaLeading DocStream))
(if (NOT (NC.FetchUserDataProp Card (QUOTE SeenBefore)))
then (SETQ ShrunkenFlg (NC.GetShrunkenWin Card))
(NC.SetUserDataProp DocCard (QUOTE SeenCards)
(CONS Card (NC.FetchUserDataProp DocCard (QUOTE
SeenCards))))
(NC.SetUserDataProp Card (QUOTE SeenBefore)
T)
(* * Stick an imageobj made from the card into the document. Also might be a textstream computed by the card type's
ExportSubstanceFn.)
(SETQ ThingToInsert (if (NCP.GraphBasedP CardType)
then (GRAPHEROBJ CardStream)
elseif (NCP.SketchBasedP CardType)
then (MAKE.IMAGE.OBJECT.OF.SKETCH (
NC.MakeExternalSketchCopy
CardStream))
elseif (LET ((ExportSubstanceFn (GETPROP
CardType
(QUOTE
ExportSubstanceFn))))
(AND ExportSubstanceFn (APPLY*
ExportSubstanceFn
CardStream)))))
(AND CardStream (if (IMAGEOBJP ThingToInsert)
then (TEDIT.INSERT.OBJECT ThingToInsert DocStream)
elseif (TEXTSTREAMP ThingToInsert)
then (TEDIT.COPY (TEDIT.SETSEL ThingToInsert 1
(fetch TEXTLEN
of (TEXTOBJ
ThingToInsert)))
(TEDIT.SETSEL DocStream
(fetch TEXTLEN
of DocObj)
1
(QUOTE RIGHT)))))
(* * Step through list of notecard imageobjs in the card we're working on and either expand or copy or ignore each
according to values of ExpandEmbeddedLinks and CopyEmbeddedLinks.)
(for Link in (CAR (NC.CollectReferences Card NIL NIL NIL))
bind LinkLabel ToCard ToCardType ActiveFlg ExpandFlg CopyFlg AlreadyExpanded
eachtime (BLOCK)
do (SETQ LinkLabel (fetch (Link Label) of Link))
(SETQ CopyFlg (OR (EQ CopyEmbeddedLinks (QUOTE ALL))
(AND (LISTP CopyEmbeddedLinks)
(FMEMB LinkLabel CopyEmbeddedLinks))))
(SETQ ExpandFlg (OR (EQ ExpandEmbeddedLinks (QUOTE ALL))
(AND (LISTP ExpandEmbeddedLinks)
(FMEMB LinkLabel ExpandEmbeddedLinks))))
(if (AND (SETQ AlreadyExpanded (NC.FetchUserDataProp
(SETQ ToCard (fetch (Link DestinationCard)
of Link))
(QUOTE SeenBefore)))
ExpandFlg)
then (NC.PrintMsg NIL NIL (NC.RetrieveTitle ToCard)
" only expanded once in this cycle."
(CHARACTER 13)))
(if (OR CopyFlg (AND ExpandFlg AlreadyExpanded))
then (* Copy this link.)
(NCP.LocalGlobalLink LinkLabel DocCard ToCard (QUOTE
END)))
(if (AND ExpandFlg (NOT AlreadyExpanded))
then (* Expand this link. Check type and make recursive
call.)
(SETQ SubSectionNum
(NC.DumpCardToDoc ToCard DocCard DocStream CurSection
SubSectionNum HeadingsFromFileboxes
TitlesFromNoteCards BuildBackLinks
CopyEmbeddedLinks ExpandEmbeddedLinks)))
finally (TEDIT.SETSEL DocStream (ADD1 (fetch TEXTLEN of DocObj))
0
(QUOTE RIGHT)))
(NC.SetUserDataProp Card (QUOTE SeenBefore)
NIL)
(AND ShrunkenFlg (SHRINKW (NC.FetchWindow Card)))
else (NC.PrintMsg NIL NIL (NC.RetrieveTitle Card)
" only expanded once in this cycle."
(CHARACTER 13)))
SubSectionNum)))
)
(PUTPROPS RHTPATCH228 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1032 1465 (NC.MakeExternalSketchCopy 1042 . 1463)) (1503 7610 (
NC.DumpExportableCardToDoc 1513 . 7608)))))
STOP