(FILECREATED " 9-Mar-87 14:25:37" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH213.;3 18953
changes to: (FNS NC.CopyStructure NC.CloseSelectedCards NC.CopyCards.NEW NC.CloseNoteCards
NC.DeleteNoteCards NC.MoveCards NCP.CopyCards NCP.CloseCards NC.CloseCards)
(VARS RHTPATCH213COMS)
previous date: " 9-Mar-87 12:52:42" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH213.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH213COMS)
(RPAQQ RHTPATCH213COMS ((* * Changes to structure operations for Peggy's new Session Icon design.)
(* * New function for NCINTERFACE)
(FNS NC.MoveCards)
(* * Changes to NCINTERFACE)
(FNS NC.CopyStructure NC.MoveStructure NC.CloseStructure NC.DeleteStructure
NC.CloseNoteCards)
(* * Change to NCDATABASE)
(FNS NC.AskTraversalSpecs)
(* * Change to NCCARDS)
(FNS NC.DeleteNoteCards)
(* * Changes to NCPROGINT)
(FNS NCP.CloseCards)))
(* * Changes to structure operations for Peggy's new Session Icon design.)
(* * New function for NCINTERFACE)
(DEFINEQ
(NC.MoveCards
(LAMBDA (Cards DestNoteFileOrFileBox RootCards QuietFlg InterestedWindow)
(* rht: " 9-Mar-87 14:17")
(* * Move cards into a filebox by copying and deleting.)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu))
(if (NULL Cards)
then (if (NULL (SETQ Cards (NC.SelectNoteCards NIL NIL NC.SelectingCardsMenu NIL
"Shift-select from the same NoteFile cards to move:")))
then (ERROR!)))
(SETQ Cards (MKLIST Cards))
(NC.CopyCards Cards DestNoteFileOrFileBox RootCards QuietFlg InterestedWindow)
(NC.DeleteNoteCards Cards T NIL InterestedWindow QuietFlg NIL)))
)
(* * Changes to NCINTERFACE)
(DEFINEQ
(NC.CopyStructure
(LAMBDA (RootCards DestinationFileBox TraversalSpecs InterestedWindow QuietFlg)
(* rht: " 9-Mar-87 14:25")
(* * Copy a NoteCard structure into a filebox)
(* * kirk 13/7/86: Placed TraversalSpecs after RootCards selection and changed prompt message)
(* * rht 9/2/86: Threw away CheckFlg arg. Wasn't being used. Changed to call NCP.CollectCards instead of outdated
NC.CollectCards. Changed arg named ToPosition to DestinationFileBox. Also changed FromCard to RootCard.
Passes two link types to NC.AskTraversalSpecs.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 3/9/87: Now accepts multiple root cards.)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu NC.SelectingCardMenu))
(SETQ RootCards (MKLIST RootCards))
(OR RootCards (SETQ RootCards (NC.SelectNoteCards NIL NIL NC.SelectingCardsMenu NIL
"Shift-select the root cards of the structure"))
(ERROR!))
(OR TraversalSpecs (SETQ TraversalSpecs (NC.AskTraversalSpecs (fetch (Card NoteFile)
of (CAR RootCards))
(QUOTE (SubBox FiledCard))))
(ERROR!))
(OR DestinationFileBox (SETQ DestinationFileBox (NC.SelectNoteCards T
(FUNCTION (LAMBDA (
Card)
(NC.FileBoxP
Card T)))
NC.SelectingCardMenu
NIL
"Shift-select the FileBox to contain the structure."))
(ERROR!))
(NC.CopyCards (NCP.CollectCards RootCards (fetch (TRAVERSALSPECS LinkTypes) of
TraversalSpecs)
(fetch (TRAVERSALSPECS Depth) of TraversalSpecs))
DestinationFileBox RootCards QuietFlg InterestedWindow)))
(NC.MoveStructure
(LAMBDA (RootCards DestinationFileBox TraversalSpecs InterestedWindow QuietFlg
Don'tPutToBeDeletedCardsFlg) (* rht: " 9-Mar-87 12:38")
(* * Copy a NoteCard structure into a filebox)
(* * rht 9/2/86: Added QuietFlg and Don'tPutToBeDeletedCardsFlg args. Changed names of a few args and removed
Don'tClearFlg arg. Took out REVERSE to save time and space.)
(* * rht 3/9/87: Now accepts multiple root cards.)
(NC.DeleteNoteCards (NC.CopyStructure (MKLIST RootCards)
DestinationFileBox TraversalSpecs InterestedWindow
QuietFlg)
T NIL InterestedWindow QuietFlg NIL Don'tPutToBeDeletedCardsFlg)))
(NC.CloseStructure
(LAMBDA (RootCards TraversalSpecs InterestedWindow QuietFlg)
(* rht: " 9-Mar-87 12:45")
(* * rht 9/2/86: Replaced call to outdated NC.CollectCards with NCP.CollectCards. Threw away useless NoCheckFlg and
Don'tClearFlg args.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 3/9/87: Now accepts multiple root cards.)
(SETQ RootCards (MKLIST RootCards))
(OR RootCards (SETQ RootCards (NC.SelectNoteCards NIL NIL NC.SelectingCardsMenu NIL
"Shift-select the root cards of the structure"))
(ERROR!))
(OR TraversalSpecs (SETQ TraversalSpecs (NC.AskTraversalSpecs (fetch (Card NoteFile)
of (CAR RootCards))
(QUOTE (SubBox FiledCard))))
)
(if (AND RootCards TraversalSpecs)
then (OR QuietFlg (NC.PrintMsg InterestedWindow T "Collecting cards to close ..."))
(NC.CloseNoteCards (NCP.CollectCards RootCards (fetch (TRAVERSALSPECS LinkTypes)
of TraversalSpecs)
(fetch (TRAVERSALSPECS Depth) of
TraversalSpecs))
NIL NIL InterestedWindow)
(OR QuietFlg (NC.ClearMsg InterestedWindow T))
RootCards)))
(NC.DeleteStructure
(LAMBDA (RootCards TraversalSpecs InterestedWindow QuietFlg Don'tPutToBeDeletedCardsFlg)
(* rht: " 9-Mar-87 12:45")
(* * rht 8/29/86: Reorganized and changed to call NCP.CollectCards which is more efficient than the old
NCP.ComputeTransitiveClosure. Also now takes QuietFlg and Don'tPutToBeDeletedCardsFlg args.
Threw away Don'tClearFlg.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 3/9/87: Now accepts multiple root cards.)
(SETQ RootCards (MKLIST RootCards))
(OR RootCards (SETQ RootCards (NC.SelectNoteCards NIL NIL NC.SelectingCardsMenu NIL
"Shift-select the root cards of the structure"))
(ERROR!))
(OR TraversalSpecs (SETQ TraversalSpecs (NC.AskTraversalSpecs (fetch (Card NoteFile)
of (CAR RootCards))
(QUOTE (SubBox FiledCard))))
)
(if (AND RootCards TraversalSpecs)
then (OR QuietFlg (NC.PrintMsg InterestedWindow T "Collecting cards to delete ..."))
(NC.DeleteNoteCards (NCP.CollectCards RootCards (fetch (TRAVERSALSPECS LinkTypes)
of TraversalSpecs)
(fetch (TRAVERSALSPECS Depth)
of TraversalSpecs))
T NIL InterestedWindow QuietFlg NIL Don'tPutToBeDeletedCardsFlg)
(OR QuietFlg (NC.ClearMsg InterestedWindow T))
RootCards)))
(NC.CloseNoteCards
(LAMBDA (CardIdOrCardList NoCheckFlg DontClearFlg InterestedWindow)
(* rht: " 9-Mar-87 14:00")
(* * Close note acrds on the screen)
(* * fgh 11/14/85 Updated to handle Card object.)
(* * kirk 21Feb86 Added InterestedWindow)
(* * fgh 6/27/86 Fixed call to NC.SelectNoteCards to use just InterestedWindow)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 3/9/87: Changed NC.DeleteSelectingMenu to NC.SelectingCardsMenu.)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu))
(LET (Cards Window)
(SETQ Cards (COND
((LISTP CardIdOrCardList))
(CardIdOrCardList (NC.CoerceToCard CardIdOrCardList))
(T (NC.SelectNoteCards NIL NIL NC.SelectingCardsMenu InterestedWindow
"Please shift-select the cards to be closed."))))
(SPAWN.MOUSE)
(for Card in (MKLIST Cards) do (COND
((AND (NC.ActiveCardP Card)
(SETQ Window (NC.FetchWindow Card)))
(COND
((NEQ (NC.QuitCard Card T)
(QUOTE DON'T))
(while (OPENWP Window) do (BLOCK))))))
))))
)
(* * Change to NCDATABASE)
(DEFINEQ
(NC.AskTraversalSpecs
(LAMBDA (NoteFile OldLinkLabels OldDepth Don'tAskFlg InterestedWindow)
(* rht: " 9-Mar-87 12:34")
(* * Get a traversal specification from the user.)
(* * kirk 7/29/86 changed to allow backlinks and position specs above source card)
(* * rht 8/29/86: Fixed bug that was causing Depth spec to be ignored.)
(* * rht 3/9/87: Now accepts InterestedWindow argument. Now takes NoteFile rather than SourceCard arg.)
(DECLARE (GLOBALVARS NC.TraversalSpecsStylesheet))
(OR InterestedWindow (SETQ InterestedWindow NC.NoteCardsIconWindow))
(PROG ((LinkLabels (NC.RetrieveLinkLabels NoteFile T))
Choices Position)
(OR OldLinkLabels (SETQ OldLinkLabels LinkLabels))
(if Don'tAskFlg
then (RETURN (LIST OldLinkLabels OldDepth)))
(SETQ Position (AND (WINDOWP InterestedWindow)
(create POSITION
XCOORD ←(fetch (REGION LEFT)
of (WINDOWPROP InterestedWindow
(QUOTE REGION)))
YCOORD ←(fetch (REGION TOP) of (WINDOWREGION
InterestedWindow)))
))
(OR OldDepth (SETQ OldDepth 99999))
(RESETFORM (CURSOR (QUOTE WAITINGCURSOR))
(* The stylesheet is in a global var.
We only need to provide its position, items, and
selections.)
(STYLE.PROP NC.TraversalSpecsStylesheet (QUOTE POSITION)
Position)
(STYLE.PROP NC.TraversalSpecsStylesheet (QUOTE ITEMS)
(LIST (create MENU
ITEMS ← LinkLabels)
(create MENU
ITEMS ←(for Link in LinkLabels
collect (PACK* (QUOTE ←)
Link)))
(create MENU
ITEMS ←(QUOTE (0 1 2 3 4 5 6 7 8 9 INF)))))
(STYLE.PROP NC.TraversalSpecsStylesheet (QUOTE SELECTIONS)
(LIST (for Label in OldLinkLabels
when (NEQ (NTHCHAR Label 1)
(QUOTE ←))
collect Label)
(for Label in OldLinkLabels
when (EQ (NTHCHAR Label 1)
(QUOTE ←))
collect Label)
(if (OR (NOT (FIXP OldDepth))
(IGREATERP OldDepth 9)
(ILESSP OldDepth 0))
then (QUOTE INF)
else OldDepth))))
(SETQ Choices (STYLESHEET NC.TraversalSpecsStylesheet))
(RETURN (COND
(Choices (create TRAVERSALSPECS
LinkTypes ←(APPEND (CAR Choices)
(CADR Choices))
Depth ←(OR (FIXP (CADDR Choices))
MAX.FIXP)))
(T NIL))))))
)
(* * Change to NCCARDS)
(DEFINEQ
(NC.DeleteNoteCards
(LAMBDA (CardIdentifiers NoIndividualConfirmFlg DontClearFlg InterestedWindow QuietFlg
NoGroupConfirmFlg) (* rht: " 9-Mar-87 14:00")
(* Delete note cards. If no card specified then get a
list of note cards to be deleted.
Then delete these cards.)
(* * fgh 11/11/85: Updated to handle new Card objects. Also split off main work of deleteing a single note card
into NC.DeleteNoteCard function.)
(* * kirk 21Feb86 Added InterestedWindow)
(* * kirk 29Apr86 Now returns CardIdentifiers)
(* * fgh 6/9/86 Added checks to see if other operations are in progress)
(* * rht 7/4/86: Now checks that card is not read-only.)
(* * kirk 18Aug86 Added main window for windowless cards.)
(* * rht 8/29/86: Reorganized and added call to NC.SeverAllLinks to make deleting more efficient.
Added QuietFlg, NoGroupConfirmFlg and Don'tPutToBeDeletedCardsFlg args.)
(* * rht 9/5/86: Now forces NoGroupConfirmFlg to be non-nil if NoIndividualConfirmFlg is NIL and only one card to
delete.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 12/16/86: Removed obsolete Don'tPutToBeDeletedCardsFlg arg.)
(* * rht 3/9/87: Changed NC.DeleteSelectingMenu to NC.SelectingCardsMenu.)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu))
(OR CardIdentifiers (SETQ CardIdentifiers (NC.SelectNoteCards NIL NIL NC.SelectingCardsMenu
InterestedWindow
"Please shift-select the Note Cards to be deleted.")))
(* * Kludge in case args are nil, say, when we're called from a card's menu.)
(if (AND (NULL NoIndividualConfirmFlg)
(NULL NoGroupConfirmFlg)
(EQ (LENGTH (MKLIST CardIdentifiers))
1))
then (SETQ NoGroupConfirmFlg T)
(SETQ QuietFlg T))
(* * First collect cards that are deletable.)
(LET ((CardsToDelete (for CardIdentifier in (MKLIST CardIdentifiers) bind Card
eachtime (BLOCK)
when (AND (SETQ Card (NC.CoerceToCard CardIdentifier))
(if (NOT (NC.TopLevelCardP Card))
else (NC.PrintMsg (NC.FetchWindow Card)
T "You cannot delete this FileBox."
(CHARACTER 13))
(DISMISS 1000)
(NC.ClearMsg (NC.FetchWindow Card)
T)
NIL)
(NC.CheckForNotReadOnly Card (NC.FetchWindow Card)
"Can't delete cards from a ")
(OR NoIndividualConfirmFlg
(PROG1 (NC.AskYesOrNo
"Are you sure you want to delete this?"
" -- " "Yes" (NULL
DontClearFlg)
(OR (NC.FetchWindow
Card)
InterestedWindow)
NIL NIL)
(NC.ClearMsg))))
collect Card))
(NumSpecified (LENGTH (MKLIST CardIdentifiers)))
NumToDelete)
(SETQ NumToDelete (LENGTH CardsToDelete))
(if (AND (GREATERP NumToDelete 0)
(if (EQUAL NumToDelete NumSpecified)
then (OR NoGroupConfirmFlg (PROG1 (NC.AskYesOrNo
(CONCAT "You've specified "
NumToDelete
" cards to delete."
(CHARACTER 13)
"Are you sure you want to delete them? ")
NIL "Yes" (NULL DontClearFlg)
InterestedWindow)
(NC.ClearMsg)))
else (PROG1 (NC.AskYesOrNo (CONCAT "Out of " NumSpecified
" cards specified, "
(DIFFERENCE NumSpecified
NumToDelete)
" are not deletable."
(CHARACTER 13)
"Want to delete the remaining "
NumToDelete " cards? ")
NIL "Yes" (NULL DontClearFlg)
InterestedWindow)
(NC.ClearMsg))))
then
(* * Mark UIDs of cards about to be deleted.)
(for Card in CardsToDelete do (NC.UIDPutProp (fetch (Card UID)
of Card)
(QUOTE AboutToBeDeletedFlg)
T))
(* * Sever all links into and out of CardsToDelete)
(NC.SeverAllLinks CardsToDelete QuietFlg InterestedWindow)
(* * Now delete the cards one at a time.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Deleting cards: 1 out of "
NumToDelete " ..."))
(for Card in CardsToDelete as i from 1 eachtime (BLOCK)
do (LET ((OperationInProgress (NC.OperationInProgress Card)))
(OR QuietFlg (if (ZEROP (REMAINDER i 10))
then (NC.PrintMsg InterestedWindow T
"Deleting cards: "
i " out of " NumToDelete
" ...")))
(if OperationInProgress
then (NC.PrintOperationInProgressMsg (NC.FetchWindow
Card)
"Delete Card(s)"
OperationInProgress)
else (NC.ProtectedCardOperation Card Delete% Card%(s%)
(NC.DeleteNoteCard Card)))))
(OR QuietFlg (NC.ClearMsg InterestedWindow T))
CardIdentifiers))))
)
(* * Changes to NCPROGINT)
(DEFINEQ
(NCP.CloseCards
(LAMBDA (Cards QuietFlg) (* rht: " 9-Mar-87 14:23")
(* * Uncache and undisplay any active cards in Cards)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(* * rht 3/9/87: Fixed so that wouldn't try to get PROCESS windowprop from NIL Win.)
(for Card in (MKLIST Cards) bind Win (OldProc ←(TTY.PROCESS))
do (if (NOT (NC.ValidCardP Card))
then (NCP.ReportError "NCP.CloseCards" (CONCAT Card
" not an existing card or filebox."))
elseif (AND (NCP.CardCachedP Card)
(NEQ (NC.QuitCard Card T NIL NIL NIL NIL NIL QuietFlg)
(QUOTE DON'T))
(SETQ Win (NC.FetchWindow Card)))
then (bind (Process ←(AND Win (WINDOWPROP Win (QUOTE PROCESS))))
until (OR (NULL Process)
(PROCESS.FINISHEDP Process))
do (BLOCK)))
finally (AND (PROCESSP OldProc)
(TTY.PROCESS OldProc))
(RETURN Card))))
)
(PUTPROPS RHTPATCH213 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1099 1854 (NC.MoveCards 1109 . 1852)) (1890 9057 (NC.CopyStructure 1900 . 3845) (
NC.MoveStructure 3847 . 4585) (NC.CloseStructure 4587 . 5996) (NC.DeleteStructure 5998 . 7571) (
NC.CloseNoteCards 7573 . 9055)) (9091 12017 (NC.AskTraversalSpecs 9101 . 12015)) (12048 17708 (
NC.DeleteNoteCards 12058 . 17706)) (17742 18871 (NCP.CloseCards 17752 . 18869)))))
STOP