(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED "23-Feb-88 19:11:46" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH093.;1 16143
changes to%: (VARS PMIPATCH093COMS))
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT PMIPATCH093COMS)
(RPAQQ PMIPATCH093COMS (
(* ;;
"pmi 2/23/88: DJ's fix to NC.CopyCards, which had check for RootCards being NONE in wrong place.")
(DECLARE%: DONTCOPY (PROPS (PMIPATCH093 MAKEFILE-ENVIRONMENT)
(PMIPATCH093 FILETYPE)))
(* ;; "Changed in NCDATABASE")
(FNS NC.CopyCards)))
(* ;;
"pmi 2/23/88: DJ's fix to NC.CopyCards, which had check for RootCards being NONE in wrong place.")
(DECLARE%: DONTCOPY
(PUTPROPS PMIPATCH093 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS PMIPATCH093 FILETYPE :BCOMPL)
)
(* ;; "Changed in NCDATABASE")
(DEFINEQ
(NC.CopyCards
[LAMBDA (Cards DestNoteFileOrFileBox RootCards QuietFlg InterestedWindow CopyExternalToLinksMode)
(* DSJ%: "23-Feb-88 14:49")
(* * Create copies of cards in Cards. If DestNoteFileOrFileBox is a notefile,
then destination will be the contents box in that notefile, else the FileBox's
notefile. RootCards should be NIL or a subset of Cards.
If NIL, then file all Cards in the dest filebox.
Otherwise, just file RootCards in that filebox and assume others are linked
somehow to the RootCards. Links between cards in Cards are copied, but links
from or to outside cards aren't.)
(* * Currently all Cards must be in same notefile, but this perhaps could be
relaxed if could prevent possibility of two cards in different notefiles having
the same UID.)
(* * kirk 24Apr86 Added calls to select cards if none provided)
(* * rht 9/2/86%: Added InterestedWindow arg.)
(* * pmi 12/12/86%: Removed obsolete ReturnLinksFlg argument in call to
NC.SelectNoteCards.)
(* * rg |3/18/87| added NC.CardSelectionOperation wrapper)
(* * rg |4/2/87| changed NC.CardSelectionOperation to NCP.WithLockedCards ;
added NC.IfAllCardsFree wrapper)
(* * rht&rg&pmi 4/22/87%: No longer calls ERROR!)
(* * rg |6/2/87| was checking for CANCELLED instead of DON'T)
(* * rg |6/5/87| deletes new cards if we cancel out halfway through)
(* * rht 6/6/87%: Now optionally copies "external" links.
Passes extra new args to NC.FixUpLinksInCardCopy.)
(* * rht 6/22/87%: Now returns list of cards copied, like it used to.)
(* * pmi 10/29/87%: Now returns list of card copies, instead of cards copied.)
(* * pmi 12/10/87%: Now returns new cards in the same order as their
corresponding original cards. At dsj's suggestion
(and implementation)%, now can pass (QUOTE NONE) as RootCards, meaning don't
file any of the new cards in the destination filebox.)
(* * dsj. |2/23/88.| Fixed bug with (QUOTE NONE) arg.)
(NCP.WithLockedCards
(NC.IfAllCardsFree
(NC.LockListOfCards Cards "Copy Cards")
(PROG (NumCards SourceNoteFile DestNoteFile BoxToFileIn TempStream CardHashArray LinksHashArray
CurrentLinkLabels NewLinkLabels NewCardsAndLocsOnStream CopyExternalToLinksFlg
NewCardList)
(* * Make sure the arguments are valid.)
(if (NULL Cards)
then (if (NULL (SETQ Cards (NC.SelectNoteCards NIL NIL NC.SelectingCardsMenu NIL
"Shift-select from the same NoteFile cards to copy:"
NIL)))
then (RETURN NIL)))
(SETQ Cards (MKLIST Cards))
(SETQ NumCards (LENGTH Cards)) (* All Cards to copy must live in same
notefile.)
(SETQ SourceNoteFile (fetch (Card NoteFile) of (CAR Cards)))
(if [NOT (AND (type? NoteFile SourceNoteFile)
(OPENP (fetch (NoteFile Stream) of SourceNoteFile]
then (NC.ReportError "NC.CopyCards" (CONCAT (fetch (NoteFile FullFileName)
of SourceNoteFile)
" not an open notefile.")))
(if (NOT (for Card in Cards always (NC.SameNoteFileP (fetch (Card NoteFile) of Card)
SourceNoteFile)))
then (NC.ReportError "NC.CopyCards"
"All cards in Cards arg don't live in the same notefile."))
(* Compute dest notefile and dest
filebox.)
(if (NOT DestNoteFileOrFileBox)
then (if (EQ 'DON'T (SETQ DestNoteFileOrFileBox (NC.SelectNoteCards T NIL
NC.SelectingCardMenu NIL
"Shift-select the FileBox to contain these cards."
T)))
then (RETURN NIL)))
(if (type? NoteFile DestNoteFileOrFileBox)
then (SETQ DestNoteFile DestNoteFileOrFileBox)
(SETQ BoxToFileIn (fetch (NoteFile TableOfContentsCard) of DestNoteFile))
elseif (NCP.FileBoxP DestNoteFileOrFileBox)
then (SETQ BoxToFileIn DestNoteFileOrFileBox)
(SETQ DestNoteFile (fetch (Card NoteFile) of BoxToFileIn))
else (NC.ReportError "NC.CopyCards" (CONCAT "Arg not notefile or filebox: "
DestNoteFileOrFileBox)))
(if [NOT (AND (type? NoteFile DestNoteFile)
(OPENP (fetch (NoteFile Stream) of DestNoteFile]
then (NC.ReportError "NC.CopyCards" (CONCAT (fetch (NoteFile FullFileName)
of DestNoteFile)
" not an open notefile.")))
(* * dsj. Fixed bug here by switching the order of the next two Sexprs.)
(if (NULL RootCards)
then (SETQ RootCards Cards)
elseif (EQ RootCards 'NONE)
then (SETQ RootCards))
(if (LDIFFERENCE (SETQ RootCards (MKLIST RootCards))
Cards)
then (NC.ReportError "NC.CopyCards"
"RootCards argument not subset of Cards argument."))
(* * Figure out whether to copy "external" links.)
[SETQ CopyExternalToLinksFlg (SELECTQ CopyExternalToLinksMode
(COPY T)
(DON'TCOPY NIL)
(SELECTQ (NC.AskUserWithMenu '(Yes No Cancel)
(CONCAT "You've asked to copy "
(LENGTH Cards)
" cards."
(CHARACTER 13)
"Links among these cards will be automatically copied."
(CHARACTER 13)
"Do you also want to copy links pointing from these cards to elsewhere? "
)
InterestedWindow)
(Yes T)
(No NIL)
(RETURN NIL]
(* * Now get to work.)
(SETQ TempStream (OPENSTREAM '{NODIRCORE} 'BOTH))
(SETQ CurrentLinkLabels (NC.RetrieveLinkLabels DestNoteFile))
(SETQ NewLinkLabels (TCONC NIL))
(SETQ LinksHashArray (HASHARRAY NC.CopyCardsLinksHashArraySize NIL (FUNCTION
NC.MakeHashKey)
(FUNCTION NC.SameUIDP)))
(SETQ CardHashArray (HASHARRAY NumCards NIL (FUNCTION NC.MakeHashKeyFromCard)
(FUNCTION NC.SameCardP)))
(* * Create new cards in DestNoteFile for each card.
Make these cards by copying original cards to a temp stream.
Keep track of UID mappings between original cards and card copies using
CardHashArray.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Copying cards: creating empty copies."
(CHARACTER 13)
"Processing item " 1 " out of " NumCards "..." (CHARACTER 13)))
(SETQ NewCardsAndLocsOnStream NIL)
[RESETLST [RESETSAVE NIL '(PROGN (if RESETSTATE
then (for CardAndLoc in NewCardsAndLocsOnStream
do (NC.DeleteNoteCardInternal (CAR
CardAndLoc
)
T InterestedWindow))
(NC.ClearMsg InterestedWindow T]
(for Card in Cards as i from 1 bind NewCard WasActiveFlg HadStatusNILFlg IndexLocs
eachtime (BLOCK) unless (NC.CrossFileLinkCardP Card)
do [OR QuietFlg (if (ZEROP (REMAINDER i 100))
then (NC.PrintMsg InterestedWindow T
"Copying cards: creating empty copies."
(CHARACTER 13)
"Processing item " i " out of " NumCards "..."
(CHARACTER 13]
(if (NOT (SETQ WasActiveFlg (NC.ActiveCardP Card)))
then (NC.GetNoteCard Card))
(if (SETQ HadStatusNILFlg (NULL (fetch (Card Status) of Card)))
then
(* Have to have Status slot ACTIVE in order that Put to stream won't break.)
(replace (Card Status) of Card with 'ACTIVE))
(SETQ IndexLocs (NC.PutNoteCardToStream Card NIL T TempStream))
(if HadStatusNILFlg
then (replace (Card Status) of Card with NIL))
(if (NOT WasActiveFlg)
then (NC.DeactivateCard Card)) (* Make new empty card for copy.)
(SETQ NewCard (NC.GetNewCard DestNoteFile))
(* Map old cards to card copies.)
(PUTHASH Card NewCard CardHashArray)
(push NewCardsAndLocsOnStream (CONS NewCard IndexLocs]
(* * For each card, get it off the temp stream, fix its links, fix browser info
if necessary, and write it down to the dest notefile.)
(SETFILEPTR TempStream 0)
(OR QuietFlg (NC.PrintMsg InterestedWindow T
"Copying cards: fixing links and browser cards." (CHARACTER 13)
"Processing item " 1 " out of " NumCards "..." (CHARACTER 13)))
(SETQ NewCardList)
(for NewCardAndLocsOnStream in NewCardsAndLocsOnStream as i from 1 eachtime (BLOCK)
bind (CrossFileLinkModePropList ← (LIST DestNoteFile NIL))
do [OR QuietFlg (if (ZEROP (REMAINDER i 100))
then (NC.PrintMsg InterestedWindow T
"Copying cards: fixing links and browser cards."
(CHARACTER 13)
"Processing item " i " out of " NumCards "..."
(CHARACTER 13]
(LET ((NewCard (CAR NewCardAndLocsOnStream))
(IndexLocs (CDR NewCardAndLocsOnStream)))
(* Have to make status active for Get fns to work.)
(NC.SetStatus NewCard 'ACTIVE)
(NC.GetNoteCardFromStream NewCard TempStream IndexLocs)
(NC.FixUpLinksInCardCopy NewCard CardHashArray LinksHashArray
CurrentLinkLabels NewLinkLabels InterestedWindow CopyExternalToLinksFlg
CrossFileLinkModePropList)
(if (NC.IsSubTypeOfP (NC.FetchType NewCard)
'Browser)
then (NC.FixUpBrowserCardCopy NewCard CardHashArray))
(NC.PutNoteCard NewCard)
(push NewCardList NewCard)))
(* * Link RootCards under filebox in DestNotefile.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Copying cards: filing " (LENGTH RootCards)
" new cards in "
(NC.FetchTitle BoxToFileIn)
"..."
(CHARACTER 13)))
(AND RootCards (NC.FileBoxCollectChildren NIL BoxToFileIn (for RootCard in RootCards
eachtime (BLOCK)
collect (GETHASH RootCard
CardHashArray
))
T))
(* * Put out any new link labels to the dest notefile.)
(AND (SETQ NewLinkLabels (CDAR NewLinkLabels))
(NC.StoreLinkLabels DestNoteFile (APPEND NewLinkLabels CurrentLinkLabels)))
(OR QuietFlg (NC.ClearMsg InterestedWindow T))
(RETURN NewCardList])
)
(PUTPROPS PMIPATCH093 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1077 16060 (NC.CopyCards 1087 . 16058)))))
STOP