(FILECREATED "18-Nov-86 13:01:37" {QV}<NOTECARDS>ADMIN>CREATE-NUMBERED-NEEDS-DOC.;3 10663
changes to: (FNS NC.DumpNoteCardToDoc)
previous date: "21-Oct-86 15:04:58" {QV}<NOTECARDS>ADMIN>CREATE-NUMBERED-NEEDS-DOC.;2)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CREATE-NUMBERED-NEEDS-DOCCOMS)
(RPAQQ CREATE-NUMBERED-NEEDS-DOCCOMS ((FNS NC.DumpNoteCardToDoc)))
(DEFINEQ
(NC.DumpNoteCardToDoc
(LAMBDA (Card DocCard DocStream SectionNum BoxNum HeadingsFromFileboxes TitlesFromNoteCards
BuildBackLinks CopyEmbeddedLinks ExpandEmbeddedLinks)
(* pmi: "18-Nov-86 10:21")
(* * Dump the CardID notecard to the document card DocStream.)
(* * rht 8/25/85: Fixed to handle sketch and graph 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.)
(* * rht 7/31/86: Now checks for card types having ExportSubstanceFn prop.)
(* * rht 8/11/86: Added ShrunkenFlg so that Card is reshrunk afterwards if necessary.)
(DECLARE (GLOBALVARS NC.CRString))
(PROG ((CardStream (NC.FetchSubstance Card))
(DocObj (TEXTOBJ DocStream))
ShrunkenFlg CardObj OldLoc TextLength)
(SETQ CardObj (TEXTOBJ CardStream))
(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)
(QUOTE Icon)))
(COND
((GREATERP (fetch (TEXTOBJ TEXTLEN) of DocObj)
OldLoc)
(NC.AddCRIfNeeded DocStream)
(NC.ChangeParaLeading DocStream)))
(COND
((NC.FetchUserDataProp Card (QUOTE SeenBefore))
(NC.PrintMsg NIL NIL (NC.RetrieveTitle Card)
" only expanded once in this cycle."
(CHARACTER 13))
(RETURN)))
(SETQ ShrunkenFlg (NC.GetShrunkenWin Card))
(NC.SetUserDataProp DocCard (QUOTE SeenCards)
(CONS Card (NC.FetchUserDataProp DocCard (QUOTE SeenCards))))
(NC.SetUserDataProp Card (QUOTE SeenBefore)
T)
(* * 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 Object in (TEDIT.LIST.OF.OBJECTS CardObj (FUNCTION NC.LinkIconImageObjP))
bind LinkSpec LinkLabel ToCard ToCardType (LastLoc ← 1)
(CurLoc ← 0)
CardSelection EndPos ParaStart ParaLooks IndentedLooks UnboldedLooks
NewLeftMargin EndStr ActiveP ExpandP CopyP AlreadyExpanded
eachtime (BLOCK)
do ((SETQ LinkSpec (NC.FetchLinkFromLinkIcon (CAR Object)))
(SETQ LinkLabel (fetch (Link Label) of LinkSpec))
(SETQ CurLoc (CADR Object)) (* Copy over any text between this obj and the last.)
(if (ILESSP LastLoc CurLoc)
then (for pos from LastLoc to CurLoc
when (STREQUAL (TEDIT.SEL.AS.STRING CardStream
(TEDIT.SETSEL
CardStream pos
3))
"To:")
do (SETQ EndPos (SUB1 pos))
(SETQ CardSelection (TEDIT.SETSEL CardStream LastLoc
EndPos))
(RETURN)
finally (SETQ EndPos (IDIFFERENCE CurLoc LastLoc))
(SETQ CardSelection (TEDIT.SETSEL CardStream LastLoc
EndPos)))
(SETQ ParaStart (ADD1 (fetch TEXTLEN of DocObj)))
(TEDIT.COPY CardSelection (TEDIT.SETSEL DocStream ParaStart 1
(QUOTE RIGHT)))
(SETQ ParaLooks (TEDIT.GET.PARALOOKS DocStream))
(SETQ IndentedLooks (COPY ParaLooks))
(SETQ NewLeftMargin (IPLUS (LISTGET ParaLooks (QUOTE
1STLEFTMARGIN))
40))
(LISTPUT IndentedLooks (QUOTE LEFTMARGIN)
NewLeftMargin)
(LISTPUT IndentedLooks (QUOTE 1STLEFTMARGIN)
NewLeftMargin)
(LISTPUT IndentedLooks (QUOTE LINELEADING)
0)
(LISTPUT IndentedLooks (QUOTE PARALEADING)
0)
(SETQ EndStr (IPLUS ParaStart EndPos))
(TEDIT.PARALOOKS DocStream IndentedLooks ParaStart EndStr)
(SETQ UnboldedLooks (TEDIT.GET.LOOKS DocStream ParaStart))
(LISTPUT UnboldedLooks (QUOTE FACE)
(QUOTE REGULAR))
(TEDIT.LOOKS DocStream UnboldedLooks ParaStart EndStr)
(TEDIT.INSERT DocStream NC.CRString (fetch TEXTLEN of DocObj))
(TEDIT.PARALOOKS DocStream ParaLooks (fetch TEXTLEN of DocObj)
1))
(SETQ LastLoc (ADD1 CurLoc))
(SETQ CopyP (OR (EQ CopyEmbeddedLinks (QUOTE ALL))
(AND (LISTP CopyEmbeddedLinks)
(FMEMB LinkLabel CopyEmbeddedLinks))))
(SETQ ExpandP (OR (EQ ExpandEmbeddedLinks (QUOTE ALL))
(AND (LISTP ExpandEmbeddedLinks)
(FMEMB LinkLabel ExpandEmbeddedLinks))))
(COND
((AND (SETQ AlreadyExpanded (NC.FetchUserDataProp (SETQ ToCard
(fetch
(Link
DestinationCard)
of LinkSpec))
(QUOTE SeenBefore)))
ExpandP)
(NC.PrintMsg NIL NIL (NC.RetrieveTitle ToCard)
" only expanded once in this cycle."
(CHARACTER 13))))
(COND
((OR CopyP (AND ExpandP AlreadyExpanded))
(* Copy this link.)
(TEDIT.COPY (TEDIT.SETSEL CardStream CurLoc 1)
(TEDIT.SETSEL DocStream (ADD1 (fetch TEXTLEN
of DocObj))
0
(QUOTE RIGHT)))))
(COND
((AND ExpandP (NOT AlreadyExpanded))
(* Expand this link. Check type and make recursive
call.)
(SETQ ActiveP (NC.ActiveCardP ToCard))
(SETQ ToCardType (NC.RetrieveType ToCard))
(COND
((EQ ToCardType (QUOTE FileBox))
(OR ActiveP (NC.GetNoteCard ToCard))
(NC.DumpFileBoxToDoc ToCard DocCard DocStream
(COND
((EQUAL SectionNum "")
(CONCAT BoxNum))
(T (CONCAT SectionNum "." BoxNum)))
HeadingsFromFileboxes TitlesFromNoteCards
BuildBackLinks CopyEmbeddedLinks
ExpandEmbeddedLinks)
(SETQ BoxNum (ADD1 BoxNum))
(OR ActiveP (NC.DeactivateCard ToCard)))
(T (COND
((NC.TEditBasedP ToCardType)
(OR ActiveP (NC.GetNoteCard ToCard))
(SETQ BoxNum
(NC.DumpNoteCardToDoc ToCard DocCard DocStream SectionNum
BoxNum HeadingsFromFileboxes
TitlesFromNoteCards BuildBackLinks
CopyEmbeddedLinks ExpandEmbeddedLinks))
(OR ActiveP (NC.DeactivateCard ToCard)))
((OR (NCP.SketchBasedP ToCardType)
(NCP.GraphBasedP ToCardType)
(GETPROP ToCardType (QUOTE ExportSubstanceFn)))
(OR ActiveP (NC.GetNoteCard ToCard))
(SETQ BoxNum
(NC.DumpExportableCardToDoc ToCard DocCard DocStream SectionNum
BoxNum HeadingsFromFileboxes
TitlesFromNoteCards BuildBackLinks
CopyEmbeddedLinks
ExpandEmbeddedLinks ToCardType))
(OR ActiveP (NC.DeactivateCard ToCard)))
(T (NC.PrintMsg NIL NIL "Ignoring non-exportable card "
(NC.RetrieveTitle ToCard)
(CHARACTER 13)))))))))
finally (if (ILESSP CurLoc (SETQ TextLength (fetch TEXTLEN of CardObj)))
then (for pos from LastLoc to TextLength
when (STREQUAL (TEDIT.SEL.AS.STRING CardStream
(TEDIT.SETSEL
CardStream pos 3))
"To:")
do (SETQ EndPos (SUB1 pos))
(SETQ CardSelection (TEDIT.SETSEL CardStream LastLoc
EndPos))
(RETURN)
finally (SETQ EndPos (IDIFFERENCE TextLength CurLoc))
(SETQ CardSelection (TEDIT.SETSEL CardStream
LastLoc EndPos)
))
(SETQ ParaStart (ADD1 (fetch TEXTLEN of DocObj)))
(TEDIT.COPY CardSelection (TEDIT.SETSEL DocStream ParaStart 0
(QUOTE RIGHT)))
(SETQ ParaLooks (TEDIT.GET.PARALOOKS DocStream))
(SETQ IndentedLooks (COPY ParaLooks))
(SETQ NewLeftMargin (IPLUS (LISTGET ParaLooks (QUOTE
1STLEFTMARGIN))
40))
(LISTPUT IndentedLooks (QUOTE LEFTMARGIN)
NewLeftMargin)
(LISTPUT IndentedLooks (QUOTE 1STLEFTMARGIN)
NewLeftMargin)
(LISTPUT IndentedLooks (QUOTE LINELEADING)
0)
(LISTPUT IndentedLooks (QUOTE PARALEADING)
0)
(SETQ EndStr (IPLUS ParaStart EndPos))
(TEDIT.PARALOOKS DocStream IndentedLooks ParaStart EndStr)
(SETQ UnboldedLooks (TEDIT.GET.LOOKS DocStream ParaStart))
(LISTPUT UnboldedLooks (QUOTE FACE)
(QUOTE REGULAR))
(TEDIT.LOOKS DocStream UnboldedLooks ParaStart EndStr)
(TEDIT.INSERT DocStream NC.CRString (fetch TEXTLEN
of DocObj))
(TEDIT.PARALOOKS DocStream ParaLooks (fetch TEXTLEN
of DocObj)
1))
(TEDIT.SETSEL DocStream (ADD1 (fetch TEXTLEN of DocObj))
0
(QUOTE RIGHT)))
(NC.SetUserDataProp Card (QUOTE SeenBefore)
NIL)
(AND ShrunkenFlg (SHRINKW (NC.FetchWindow Card)))
(RETURN BoxNum))))
)
(PUTPROPS CREATE-NUMBERED-NEEDS-DOC COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (427 10567 (NC.DumpNoteCardToDoc 437 . 10565)))))
STOP