(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED " 6-Sep-88 15:14:06" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH108.;1 10551
changes to%: (FNS NC.DeleteNoteCards)
(VARS PMIPATCH108COMS))
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT PMIPATCH108COMS)
(RPAQQ PMIPATCH108COMS (
(* ;;; "New file")
(DECLARE%: DONTCOPY (PROPS (PMIPATCH108 MAKEFILE-ENVIRONMENT)
(PMIPATCH108 FILETYPE)))
(* ;; "pmi 9/6/88: Removed redundant calls to NC.ClearMsg which were causing TTY window for mouse to appear because it was being called with no arguments. ")
(* ;; "Changed in NCCARDS")
(FNS NC.DeleteNoteCards)))
(* ;;; "New file")
(DECLARE%: DONTCOPY
(PUTPROPS PMIPATCH108 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS PMIPATCH108 FILETYPE :BCOMPL)
)
(* ;;
"pmi 9/6/88: Removed redundant calls to NC.ClearMsg which were causing TTY window for mouse to appear because it was being called with no arguments. "
)
(* ;; "Changed in NCCARDS")
(DEFINEQ
(NC.DeleteNoteCards
[LAMBDA (CardIdentifiers NoIndividualConfirmFlg DontClearFlg InterestedWindow QuietFlg
NoGroupConfirmFlg) (* ; "Edited 6-Sep-88 15:00 by pmi")
(* ;; "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.")
(* ;;; "rg 3/9/87 added NC.ProtectedSessionOperation wrapper")
(* ;;; "rg 3/11/87 changed call of NC.DeleteNoteCard to NC.DeleteNoteCardInternal")
(* ;;; "rg 3/18/87 changed NC.ProtectedSessionOperation to NC.CardSelectionOperation")
(* ;;; "rht 3/30/87: Now calls NC.SeverExternalLinks rather than NC.SeverAllLinks.")
(* ;;; "dsj 9/28/87: Added call to NC.CardsToDelete which accesses the WhenDeletedFn prop of card type. This does not yet handle the general case of allowing me to bypass asking the user for confirmation, which is an operation that should be a super type's WhenDeletedFn.")
(* ;;; "pmi 1/15/88: Added dsj's change (see above comment)")
(* ;;; "pmi 9/6/88: Removed redundant calls to NC.ClearMsg which were causing TTY window for mouse to appear because it was being called with no arguments. ")
(DECLARE (GLOBALVARS NC.SelectingCardsMenu))
(NCP.WithLockedCards
(NC.IfAllCardsFree
(NC.LockListOfCards (MKLIST CardIdentifiers)
"Delete Note Cards")
(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] collect Card))
(NumSpecified (LENGTH (MKLIST CardIdentifiers)))
NumToDelete FinalNumToDelete)
(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]
then
(* ;;; "dsj 9/28/87: Let programmer have control over aborting deletion here.")
(SETQ CardsToDelete (NC.CardsToDelete CardsToDelete))
(SETQ FinalNumToDelete (LENGTH CardsToDelete))
(if (GREATERP FinalNumToDelete 0)
then (if (GREATERP NumToDelete FinalNumToDelete)
then (NC.PrintMsg InterestedWindow T "Can only delete "
FinalNumToDelete " cards out of " NumToDelete
" specified for deletion.")
(DISMISS 3000)
(NC.ClearMsg InterestedWindow))
(* ;;; "Mark UIDs of cards about to be deleted.")
(for Card in CardsToDelete do (NC.UIDPutProp (fetch (Card UID)
of Card)
'AboutToBeDeletedFlg T))
(* ;;; "Sever all links into and out of CardsToDelete")
(NC.SeverExternalLinks CardsToDelete QuietFlg InterestedWindow)
(* ;;; "Now delete the cards one at a time.")
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Deleting cards: 1 out of "
FinalNumToDelete " ..."))
(for Card in CardsToDelete as i from 1 eachtime (BLOCK)
do (OR QuietFlg
(if (ZEROP (REMAINDER i 10))
then (NC.PrintMsg InterestedWindow T "Deleting cards: " i
" out of " FinalNumToDelete " ...")))
(NC.DeleteNoteCardInternal Card QuietFlg InterestedWindow T))
(OR QuietFlg (NC.ClearMsg InterestedWindow T)))
CardIdentifiers])
)
(PUTPROPS PMIPATCH108 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1311 10468 (NC.DeleteNoteCards 1321 . 10466)))))
STOP