(FILECREATED "15-Jan-88 11:51:32" {QV}<NOTECARDS>1.3KNEXT>PMIPATCH075.;15 128661
changes to: (FNS NC.DeleteNoteCard NC.DeleteNoteCards NC.CardsToDelete NCP.CreateLinkType
NCP.NoteFileClosingP)
(VARS PMIPATCH075COMS)
previous date: " 6-Jan-88 14:56:53" {QV}<NOTECARDS>1.3KNEXT>PMIPATCH075.;12)
(* Copyright (c) 1987, 1988 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PMIPATCH075COMS)
(RPAQQ PMIPATCH075COMS ((* * pmi 12/31/87: This patch file integrates a bunch of bug fixes, added
features, and programmer's interface functions made or suggested by Dan
Jordan in the course of his IDE hacking, and related changes and
additions.)
(DECLARE: COPY FIRST (P (NC.LoadFileFromDirectories (QUOTE NCBROWSERCARD))))
(* * Changed in NCPROGINT)
(FNS NCP.AddNoteFileIconMiddleButtonItems NCP.DisplayedCards NCP.CreateCard
NCP.ValidCardP NCP.ListRegisteredCards NCP.OpenNoteFile
NCP.CreateLinkType)
(* * New in NCPROGINT)
(FNS NCP.AddDefaultNoteFileIconMiddleButtonItems
NCP.NoticedNoteFileNamesMenu NCP.AddTitleBarMenuItemsToType
NCP.AddTitleBarMenuItemsToWindow NCP.LinkIconAttachedBitMap
NCP.SessionIconWindow NCP.BringUpSessionIcon NCP.SystemLinkTypeP
NCP.CardBeingDeletedP NCP.NoteFileClosingP)
(INITVARS (NCP.DefaultLinkIconAttachedBitMapSize 17))
(* * Changed in NCDATABASE)
(FNS NC.NoticedNoteFileNamesMenu NC.RunCloseEvents NC.CopyCards
NC.AbortSession NC.OpenNoteFile NC.ProcessNoteFileNotFoundError
NC.NoteFileNoticedP NC.NoticeNoteFileName NC.RemoveNoteFileName)
(* * Changed in NCINTERFACE)
(FNS NC.BringUpNoteCardsIcon NC.AskNoteCardType NC.SetUpNoteFileInterface
NC.ListOfNoteFilesMenu)
(* * New in NCINTERFACE)
(* * Was NC.NoticedNoteFileNames, which should be removed from NCINTERFACE
coms.)
(GLOBALVARS NCP.NoticedNoteFileNames)
(VARS (NCP.NoticedNoteFileNames NIL))
(* * Changed in NCLISTCARD)
(FNS NC.EvaluateListCardSubstance)
(* * New in NCCARDS)
(FNS NC.CardsToDelete)
(* * Changed in NCCARDS)
(FNS NC.EditNoteCard NC.CardSaveFn NC.SeverExternalLinks
NC.RetrieveLinkLabels NC.DeleteNoteCard NC.DeleteNoteCards)
(* * Changed in NCTEXTCARD)
(FNS NC.MakeTEditCard)
(* * Changed in NCTYPESMECH)
(FNS NC.DeleteCardType)
(* * Changed in NCBROWSERCARD)
(FNS NC.GetBrowserNodeID)))
(* * pmi 12/31/87: This patch file integrates a bunch of bug fixes, added features, and
programmer's interface functions made or suggested by Dan Jordan in the course of his IDE
hacking, and related changes and additions.)
(DECLARE: COPY FIRST
(NC.LoadFileFromDirectories (QUOTE NCBROWSERCARD))
)
(* * Changed in NCPROGINT)
(DEFINEQ
(NCP.AddNoteFileIconMiddleButtonItems
(LAMBDA (NoteFile MenuItems) (* pmi: " 5-Jan-88 15:44")
(* * Add the given MenuItems to the given NoteFile.)
(* * pmi 1/5/88: Now won't add a menu item if it is already on the menu.)
(if NoteFile
then (LET ((ExistingMenuItems (NCP.NoteFileProp NoteFile (QUOTE
NoteFileIconMiddleButtonItems)))
(NoteFileIconWindow (NCP.NoteFileIconWindow NoteFile)))
(NCP.NoteFileProp NoteFile (QUOTE NoteFileIconMiddleButtonItems)
(NCONC ExistingMenuItems
(for MenuItem in MenuItems collect MenuItem
when (NOT (MEMBER MenuItem
ExistingMenuItems)))))
(* * Smash stashed menu so as to force recompute.)
(* Menu is no longer cached on the window.)
(* (if (OPENWP NoteFileIconWindow) then
(WINDOWPROP NoteFileIconWindow
(QUOTE NoteFileMiddleButtonMenu) NIL)))
ExistingMenuItems))))
(NCP.DisplayedCards
(LAMBDA (NoteFiles CardTypes) (* pmi: " 7-Dec-87 16:21")
(* * Return a list of all cards that are currently displayed in a window.)
(* * dsj 10/1/87: Added NoteFiles and CardTypes args. If either are NIL, then all NoteFiles and/or CardTypes are
considered.)
(* * pmi 12/7/87: Integrated above change by dsj into NC sources.)
(SETQ NoteFiles (MKLIST NoteFiles))
(SETQ CardTypes (MKLIST CardTypes))
(for Win in (OPENWINDOWS) bind Card when (AND (SETQ Card
(NC.CoerceToCard
(OR (WINDOWPROP Win
(QUOTE
ICONFOR))
Win)))
(if NoteFiles
then (for NoteFile
in NoteFiles
bind
(CardNoteFile
←(NCP.CardNoteFile
Card))
thereis (EQ NoteFile
CardNoteFile))
else T)
(if CardTypes
then (for Type in CardTypes
bind
(CardType ←(
NCP.CardType
Card))
thereis (EQ Type
CardType))
else T))
collect Card)))
(NCP.CreateCard
(LAMBDA (Type NoteFile Title NoDisplayFlg Props ParentFileBoxes TypeSpecificArgs)
(* pmi: "10-Dec-87 10:27")
(* * Creates a new notecard with given type, title, props and parents. Any of those args can be nil.
Type being NIL will cause user to be asked. Makes a card with initially empty substance.)
(* * rht 11/20/84: Had to add a horrible kluge: if creating a document card in which embedded links may be copied,
then need to have document card visible on screen. This is because ID is currently unattainable from just the
Textstream -
need to have a window. Until that is fixed, we temporarily bring up the document card while it's being filled in.)
(* * rht 11/17/85: Updated to handle new card and notefile objects.)
(* * rht 7/10/86: Ripped out the above described document kludge.)
(* * rht 8/21/86: Now sticks (APPEND Props) on the card's proplist, i.e. a top level copy.)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(* * dsj 9/23/87: Added (NC.RetrievePropList Card) to APPEND to preserve properties set by user's makefn.)
(* * pmi 12/10/87: Added dsj's change; see above comment.)
(if (NCP.CardTypeP Type)
then (LET (Card CardIdentifier)
(if (SETQ CardIdentifier (NC.MakeNoteCard Type NoteFile Title NoDisplayFlg
TypeSpecificArgs))
then (SETQ Card (if (WINDOWP CardIdentifier)
then (NCP.CardFromWindow CardIdentifier)
else CardIdentifier))
(if Props
then (NC.SetPropList Card (APPEND Props (
NC.RetrievePropList
Card)))
(NC.SetPropListDirtyFlg Card T))
(for Box in (MKLIST ParentFileBoxes)
do (if (NCP.FileBoxP Box)
then (NCP.FileCards Card Box)
else (NCP.ReportError (QUOTE NCP.CreateCard)
(CONCAT Box
" not an existing filebox."))))
Card))
else (NCP.ReportError (QUOTE NCP.CreateCard)
(CONCAT "Unknown card type: " Type))
NIL)))
(NCP.ValidCardP
(LAMBDA (Card) (* pmi: "10-Dec-87 11:34")
(* * Non-nil if ID corresponds to extant card in current notefile. Returns type of card or nil.)
(* * pmi 12/10/87: Changed to call NC.ValidCardP rather than NC.CardType (how odd!) as a check for validity.
Also now returns the card if successful.)
(if (NC.ValidCardP Card)
then Card)))
(NCP.ListRegisteredCards
(LAMBDA (NoteFileOrRegistryCard IncludeKeysFlg) (* pmi: "10-Dec-87 17:19")
(* * Return the list of cards registered in the RegistryCard or notefile. If IncludeKeysFlg is non-nil, then return
dotted pairs of key and card, else just list of cards.)
(* * pmi 12/10/87: now returns cards instead of UIDs.)
(LET (RegistryCard NoteFile Result)
(COND
((NCP.OpenNoteFileP NoteFileOrRegistryCard)
(SETQ RegistryCard (fetch (NoteFile RegistryCard) of NoteFileOrRegistryCard))
(SETQ NoteFile NoteFileOrRegistryCard))
((AND (NC.ValidCardP NoteFileOrRegistryCard)
(EQ (NCP.CardType NoteFileOrRegistryCard)
(QUOTE Registry)))
(SETQ RegistryCard NoteFileOrRegistryCard)
(SETQ NoteFile (NCP.CardNoteFile RegistryCard)))
(T (NCP.ReportError (QUOTE NCP.ListRegisteredCards)
(CONCAT "Improper arg: " NoteFileOrRegistryCard))))
(if IncludeKeysFlg
then (MAPHASH (NCP.CardSubstance RegistryCard)
(FUNCTION (LAMBDA (Val Key)
(push Result (CONS Key (NC.CardFromUID Val NoteFile))))))
else (MAPHASH (NCP.CardSubstance RegistryCard)
(FUNCTION (LAMBDA (Val Key)
(push Result (NC.CardFromUID Val NoteFile))))))
Result)))
(NCP.OpenNoteFile
(LAMBDA (NoteFileOrFileName Don'tCreateFlg Convertw/oConfirmFlg QuietFlg MenuPosition ReadOnlyFlg
Don'tCreateInterfaceFlg) (* pmi: "24-Nov-87 09:27")
(* * Prog's intface version of opening a notefile.)
(* * rht 7/7/86: Now takes QuietFlg and MenuPosition arg. Takes either NoteFile object or file name.)
(* * rht 7/16/86: Added ReadOnlyFlg arg.)
(* * rht 7/26/86: Added Don'tCreateInterfaceFlg)
(* * Fix to bug #391: Now calls NC.OpenNoteFile instead of NC.OpenDatabaseFile.)
(* * pmi 5/20/87: Removed HashArray argument in calls to NC.OpenNoteFile.)
(* * pmi 11/24/87: Deleted extra NIL in call to NC.OpenNoteFile.)
(if (type? NoteFile NoteFileOrFileName)
then (NC.OpenNoteFile NoteFileOrFileName NIL Don'tCreateFlg Convertw/oConfirmFlg NIL NIL
Don'tCreateInterfaceFlg NIL NIL NIL MenuPosition QuietFlg
(AND ReadOnlyFlg (QUOTE INPUT))
NIL)
else (LET ((FileNameWithExt (NC.DatabaseFileName "Name of NoteFile to open:" " -- " T NIL
NoteFileOrFileName)))
(AND FileNameWithExt
(NC.OpenNoteFile FileNameWithExt NIL Don'tCreateFlg Convertw/oConfirmFlg
NIL NIL Don'tCreateInterfaceFlg NIL NIL NIL MenuPosition
QuietFlg (AND ReadOnlyFlg (QUOTE INPUT))
NIL))))))
(NCP.CreateLinkType
(LAMBDA (LinkType NoteFile QuietFlg) (* pmi: "13-Jan-88 15:07")
(* * Create a new link label unless already defined.)
(* * rht 11/18/85: Updated to handle new notefile and card object formats.)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(* * pmi 1/13/88: Added QuietFlg argument to control printing of error message)
(if (FMEMB LinkType (NCP.LinkTypes NoteFile))
then (OR QuietFlg (NCP.ReportError (QUOTE NCP.CreateLinkType)
(CONCAT "Link type already defined: " LinkType ".")
))
NIL
else (NC.StoreLinkLabels NoteFile (CONS LinkType (NCP.UserLinkTypes NoteFile)))
LinkType)))
)
(* * New in NCPROGINT)
(DEFINEQ
(NCP.AddDefaultNoteFileIconMiddleButtonItems
(LAMBDA (NewItems) (* pmi: " 5-Jan-88 15:11")
(* * 10/23/87. dsj. Uniquely add NewItems to NC.DefaultNoteFileIconMiddleButtonItems so that ALL open notefiles
will have the new menu item without needing to be "initialized" first.)
(* * pmi 1/5/88: Added this function created by DJ (see above comment). Added GLOBALVARS declaration.)
(DECLARE (GLOBALVARS NC.DefaultNoteFileIconMiddleButtonItems))
(AND NewItems (NCONC NC.DefaultNoteFileIconMiddleButtonItems
(for NewItem in NewItems collect NewItem
when (NOT (MEMBER NewItem
NC.DefaultNoteFileIconMiddleButtonItems)))))))
(NCP.NoticedNoteFileNamesMenu
(LAMBDA (IncludeNewNoteFileFlg AllowedOperations InterestedWindow Operation)
(* pmi: " 9-Dec-87 12:33")
(* * AllowedOperations should be one of the atoms: OPEN, CLOSED, or NIL for both. Operation should be a string or
atom containing the name of the operation to be performed on the result and the word NoteFile;
e.g. (QUOTE Open% NoteFile) This is used in the prompt for a new notefile name.)
(* * dsj 11/6/87: Give user a menu of noticed notefile names.)
(* * pmi 12/9/87: Added this function, which was created by dsj (see above comment.))
(NC.NoticedNoteFileNamesMenu IncludeNewNoteFileFlg AllowedOperations InterestedWindow Operation)
))
(NCP.AddTitleBarMenuItemsToType
(LAMBDA (Type Button NewMenuItems TopOrBottom) (* pmi: "31-Dec-87 13:39")
(* * DSJ: 10/6/87 Add NewMenuItems to the menu items for the card type if not already a menu item.
Also use TopOrBottom (one of (QUOTE Top) or (QUOTE Bottom)) to determine where in the menu the new items should be
placed. If TopOrBottom is NIL put on bottom of menu. Button should be one of (QUOTE Left) or
(QUOTE Right,) indicating which menu to add to.)
(* * pmi 12/31/87: Added DSJ's function (renamed) to the programmer's interface; see comment above.)
(LET (Items Menu) (* If NULL Items then assume we don't want it for this
card type)
(SETQ Menu (SELECTQ (U-CASE Button)
(LEFT (QUOTE LeftButtonMenuItems))
(RIGHT (QUOTE RightButtonMenuItems))
(NCP.ReportError (QUOTE NCP.AddTitleBarMenuItemsToType)
"Button incorrectly specified.")))
(SETQ Items (NCP.CardTypeVar Type Menu))
(AND Items
(NCP.ChangeCardTypeFields
Type NIL
(BQUOTE (QUOTE (, Menu ,
(SELECTQ (OR (U-CASE TopOrBottom)
(QUOTE BOTTOM))
(TOP (NCONC (for NewItem in NewMenuItems
collect NewItem
when (NOT (MEMBER NewItem
Items)))
Items))
(BOTTOM (APPEND Items
(for NewItem in NewMenuItems
collect NewItem
when (NOT (MEMBER
NewItem Items)
))))
(NCP.ReportError (QUOTE
NCP.AddTitleBarMenuItemsToType)
"Location of new items in the menu incorrectly specified.")))))
)))))
(NCP.AddTitleBarMenuItemsToWindow
(LAMBDA (Window Button NewMenuItems TopOrBottom) (* pmi: "31-Dec-87 13:39")
(* * pmi 12/31/87: Add the given menu items to the appropriate button menu of Window, as determined by Button.
Also use TopOrBottom (one of (QUOTE Top) or (QUOTE Bottom)) to determine where in the menu the new items should be
placed. If TopOrBottom is NIL put on bottom of menu. Button should be one of (QUOTE Left) or
(QUOTE Right,) indicating which menu to add to. This change was borrowed from dsj's implementation of
NCP.AddTitleBarMenuToType.)
(LET ((Menu (WINDOWPROP Window (SELECTQ (U-CASE Button)
(LEFT (QUOTE TitleBarLeftButtonMenu))
(RIGHT (QUOTE TitleBarRightButtonMenu))
(NCP.ReportError (QUOTE
NCP.AddTitleBarMenuItemsToWindow)
"Button incorrectly specified."))))
Items)
(if Menu
then (SETQ Items (fetch (MENU ITEMS) of Menu))
(replace (MENU ITEMS) of Menu
with (SELECTQ (OR (U-CASE TopOrBottom)
(QUOTE BOTTOM))
(TOP (NCONC (for NewItem in NewMenuItems collect
NewItem
when (NOT (MEMBER NewItem Items)))
Items))
(BOTTOM (APPEND Items
(for NewItem in NewMenuItems
collect NewItem
when (NOT (MEMBER NewItem Items)))
))
(NCP.ReportError (QUOTE NCP.AddTitleBarMenuItemsToWindow)
"Location of new items in the menu incorrectly specified.")))
(replace (MENU IMAGE) of Menu with NIL)))))
(NCP.LinkIconAttachedBitMap
(LAMBDA (TypeName Size) (* pmi: "31-Dec-87 13:32")
(* * dsj. This returns the link iconattached bitmap of size Size for card type Type. Default size is 17 x 17.0)
(* * pmi 12/30/87: Added dsj's function to the programmer's interface; see comment above. Placed default value in
new globalvar NCP.DefaultLinkIconAttachedBitMapSize.)
(DECLARE (GLOBALVARS NCP.DefaultLinkIconAttachedBitMapSize))
(LET ((BitMap (NCP.CardTypeVar TypeName (QUOTE LinkIconAttachedBitMap))))
(AND BitMap (OR (BITMAPP BitMap)
(LISTGET BitMap (OR Size (NUMBERP
NCP.DefaultLinkIconAttachedBitMapSize)))))
)))
(NCP.SessionIconWindow
(LAMBDA NIL (* pmi: " 8-Dec-87 15:32")
(* * pmi 12/8/87: Created to provide programmer's interface access to NC.NoteCardsIconWindow.)
(DECLARE (GLOBALVARS NC.NoteCardsIconWindow))
NC.NoteCardsIconWindow))
(NCP.BringUpSessionIcon
(LAMBDA (IconPosition) (* pmi: " 9-Dec-87 12:07")
(* * Start up NoteCards by bringing up the NoteCards icon at IconPosition)
(NC.BringUpNoteCardsIcon (if (POSITIONP IconPosition)
then IconPosition))))
(NCP.SystemLinkTypeP
(LAMBDA (LinkType) (* pmi: " 8-Dec-87 15:36")
(* * dsj 10/24/87: Is LinkType a system link label?)
(* * pmi 12/8/87: Added dsj's function; see comment above.)
(NC.SystemLinkLabelP LinkType)))
(NCP.CardBeingDeletedP
(LAMBDA (Card) (* pmi: "10-Dec-87 11:40")
(* * pmi 12/10/87: Created to provide NC.FetchBeingDeletedFlg for the programmer's interface.)
(NC.FetchBeingDeletedFlg Card)))
(NCP.NoteFileClosingP
(LAMBDA (DontCheckForAbortFlg) (* DSJ: " 7-Nov-87 00:28")
(* * dsj 10/12/87. This fn looks up the stack to see if the notefile's being closed. Not pretty, but there's no
other way to tell. Unless DontCheckForAbortFlg, aborting the notefile counts as closing it.)
(OR (RELSTK (STKPOS (QUOTE NC.CloseNoteFile)))
(AND (NOT DontCheckForAbortFlg)
(RELSTK (STKPOS (QUOTE NC.AbortSession)))))))
)
(RPAQ? NCP.DefaultLinkIconAttachedBitMapSize 17)
(* * Changed in NCDATABASE)
(DEFINEQ
(NC.NoticedNoteFileNamesMenu
(LAMBDA (IncludeNewNoteFileFlg AllowedOperations InterestedWindow Operation)
(* pmi: "30-Dec-87 15:55")
(* * Bring up a menu of all notefiles found in the notefiles hash array. Also allow user to open a new notefile.)
(* * kirk 23Jan86 Added AskYesOrNo and InterestedWindow parameter)
(* * fgh 6/8/86 Added check to make sure NoteFile is open if it has a menu on the screen. Needed to handle case of
liongering NF menus.)
(* * fgh 6/24/86 Changed to be a general function rather than one specific for opening. Now just returns the chosen
name. Also, added IncludeNewNoteFileFlg and ShowOnlyOpenNFsFlg. Removed InterestedWindow arg.)
(* * fgh 6/27/86 Added InterestedWindow & Operation args and call to NC.DatabaseFileName.)
(* * pmi 12/4/86: Added version numbers to rootnames on list of known files. Also cleaned up help string for menu
items. It was giving a bogus message about opening the selected file, even though this function is used for many
operations and not just for Open.)
(* * pmi 2/18/87: Added GLOBALVARS declaration for NC.MenuFont)
(* * pmi 5/15/87: Used to be NC.ListOfNoteFilesMenu. Changed symbol for open notefile to o.
Now uses NCP.NoticedNoteFileNames instead of hash array to build menu. Returns a NoteFile name instead of a
NoteFile object.)
(* * pmi 5/21/87: Replaced each NoteFile menu item with a bitmap of its name in a large font and its full filename
in a small font.)
(* * pmi 8/20/87: Made modifications to speed up this menu: cache it when possible, only recompute the shading,
etc.)
(* * pmi 12/8/87: Cleaned up some of the shading; converted AllowedOperations to be one of Open, CLOSED or NIL for
both.)
(* * pmi 12/30/87: Changed the global var NC.NoticedNoteFileNames to NCP.NoticedNoteFileNames to make it available
in the programmer's interface. Also wrapped U-CASE around all SELECTQ vars so that case doesn't matter.)
(DECLARE (GLOBALVARS NC.FileNameFont NCP.NoticedNoteFileNames NC.NoticedNoteFilesMenu
NC.NoticedNoteFilesMenuNewItem WHITESHADE GRAYSHADE))
(LET (Result)
(SETQ Result
(PROG (Items)
(if (NULL NC.NoticedNoteFilesMenu)
then (SETQ Items (BQUOTE
(,@(for NoteFileName in NCP.NoticedNoteFileNames bind
NoteFile
collect (SELECTQ (U-CASE (GETPROP NoteFileName
(QUOTE
LastKnownStatus)))
(OPEN (GETPROP NoteFileName
(QUOTE OpenMenuItem)))
(CLOSED (GETPROP NoteFileName
(QUOTE
ClosedMenuItem)))
NIL))
,@(if NC.NoticedNoteFilesMenuNewItem
then (LIST NC.NoticedNoteFilesMenuNewItem)
else (LIST (SETQ NC.NoticedNoteFilesMenuNewItem
(QUOTE ("-- Other NoteFile --"
(QUOTE NEW)
"Select some other notefile - you'll be prompted for the name.")))))
)))
(if (NULL Items)
then (SELECTQ (U-CASE AllowedOperations)
(OPEN (NC.PrintMsg InterestedWindow NIL
"No open NoteFiles."
(CHARACTER 13)))
(CLOSED (NC.PrintMsg InterestedWindow NIL
"No closed NoteFiles."
(CHARACTER 13)))
(NC.PrintMsg InterestedWindow NIL
"No NoteFiles."
(CHARACTER 13)))
(RETURN NIL)
elseif (AND (EQ (LENGTH Items)
1)
(EQUAL (CADAR Items)
(QUOTE (QUOTE NEW))))
then (RETURN (QUOTE NEW))
else (SETQ NC.NoticedNoteFilesMenu
(create MENU
ITEMS ← Items
TITLE ← "NoteFiles"
MENUFONT ← NC.FileNameFont
ITEMHEIGHT ←(IPLUS (BITMAPHEIGHT (CAAR
Items))
1)))))
(* * Shade either the open or closed files, depending on the type allowed by this operation.)
(SELECTQ (U-CASE AllowedOperations)
(OPEN (for NoteFileName in NCP.NoticedNoteFileNames
do (SELECTQ (U-CASE (GETPROP NoteFileName
(QUOTE LastKnownStatus))
)
(OPEN (SHADEITEM (GETPROP NoteFileName
(QUOTE
OpenMenuItem))
NC.NoticedNoteFilesMenu
WHITESHADE))
(CLOSED (SHADEITEM (GETPROP NoteFileName
(QUOTE
ClosedMenuItem))
NC.NoticedNoteFilesMenu
GRAYSHADE))
(SHADEITEM (GETPROP NoteFileName
(QUOTE OpenMenuItem))
NC.NoticedNoteFilesMenu
WHITESHADE))))
(CLOSED (for NoteFileName in NCP.NoticedNoteFileNames
do (SELECTQ (U-CASE (GETPROP NoteFileName
(QUOTE
LastKnownStatus)))
(OPEN (SHADEITEM (GETPROP NoteFileName
(QUOTE
OpenMenuItem)
)
NC.NoticedNoteFilesMenu
GRAYSHADE))
(CLOSED (SHADEITEM (GETPROP
NoteFileName
(QUOTE
ClosedMenuItem))
NC.NoticedNoteFilesMenu
WHITESHADE))
(SHADEITEM (GETPROP NoteFileName
(QUOTE
OpenMenuItem))
NC.NoticedNoteFilesMenu
WHITESHADE))))
(for NoteFileName in NCP.NoticedNoteFileNames
do (SELECTQ (U-CASE (GETPROP NoteFileName (QUOTE
LastKnownStatus)))
(OPEN (SHADEITEM (GETPROP NoteFileName
(QUOTE OpenMenuItem))
NC.NoticedNoteFilesMenu
WHITESHADE))
(CLOSED (SHADEITEM (GETPROP NoteFileName
(QUOTE
ClosedMenuItem))
NC.NoticedNoteFilesMenu
WHITESHADE))
(SHADEITEM (GETPROP NoteFileName (QUOTE
OpenMenuItem))
NC.NoticedNoteFilesMenu WHITESHADE))))
(* * Shade the new notefile item if a new notefile is allowed.)
(if IncludeNewNoteFileFlg
then (SHADEITEM NC.NoticedNoteFilesMenuNewItem NC.NoticedNoteFilesMenu
WHITESHADE)
else (SHADEITEM NC.NoticedNoteFilesMenuNewItem NC.NoticedNoteFilesMenu
GRAYSHADE))
(replace (MENU IMAGE) of NC.NoticedNoteFilesMenu with NIL)
(RETURN (MENU NC.NoticedNoteFilesMenu))))
(if (EQ Result (QUOTE NEW))
then (if IncludeNewNoteFileFlg
then (SETQ Result (NC.DatabaseFileName (CONCAT "Name of NoteFile to "
(SUBSTRING Operation
1 -9)
(CHARACTER 13))
" -- " T T NIL InterestedWindow))
else (NC.PrintMsg InterestedWindow T "Can't " Operation " a new notefile."
(CHARACTER 13))
(DISMISS 500)
(SETQ Result NIL)))
Result)))
(NC.RunCloseEvents
(LAMBDA (NoteFileOrName When) (* pmi: " 5-Jan-88 14:49")
(* * If When = AFTER then read and eval the CloseEvents card.)
(* * dsj 9/22/87: Dropped "NoteFileName" as the first arg passed in and changed to just NoteFileOrName.)
(* * dsj 9/23/87: BEFORE/AFTER needed major rehacking: BEFORE now means before the NF is closed
(i.e., the NF stream still exists) and AFTER means after the stream has been closed. Because we can't retrieve the
registry card in the AFTER case, need to save its content special during BEFORE execution. "When" can be referenced
by the called closing fns.)
(* * pmi 1/5/88: added dsj's changes; see above comments.)
(LET (NoteFile)
(SETQ NoteFile (if (type? NoteFile NoteFileOrName)
then NoteFileOrName
else (NC.NoteFileFromFileName NoteFileOrName)))
(SELECTQ (U-CASE When)
(BEFORE (LET ((CloseEventsCard (NCP.LookupCardByName (QUOTE CloseEventsCard)
NoteFile)))
(if (NCP.ValidCardP CloseEventsCard)
then
(* * dsj: Save CloseEventsCard substance for AFTER execution.)
(PUTPROP (MKATOM NoteFile)
(QUOTE CloseEvents)
(NCP.CardSubstance CloseEventsCard))
(NC.EvaluateListCardSubstance CloseEventsCard
"Evaluating the CloseEvents card before"
(NCP.NoteFileIconWindow
NoteFile)
T))))
(AFTER (LET ((CloseEvents (GETPROP (MKATOM NoteFile)
(QUOTE CloseEvents))))
(if CloseEvents
then (NC.EvaluateListCardSubstance CloseEvents
"Evaluating the Close Events card after"
(NCP.NoteFileIconWindow
NoteFile)
T))))
NIL))))
(NC.CopyCards
(LAMBDA (Cards DestNoteFileOrFileBox RootCards QuietFlg InterestedWindow CopyExternalToLinksMode)
(* pmi: "10-Dec-87 17:58")
(* * 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.)
(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 (QUOTE 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.")))
(if (LDIFFERENCE (SETQ RootCards (MKLIST RootCards))
Cards)
then (NC.ReportError "NC.CopyCards"
"RootCards argument not subset of Cards argument."))
(if (NULL RootCards)
then (SETQ RootCards Cards)
elseif (EQ RootCards (QUOTE NONE))
then (SETQ RootCards))
(* * Figure out whether to copy "external" links.)
(SETQ CopyExternalToLinksFlg
(SELECTQ CopyExternalToLinksMode
(COPY T)
(DON'TCOPY NIL)
(SELECTQ (NC.AskUserWithMenu (QUOTE
(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 (QUOTE {NODIRCORE})
(QUOTE 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
(QUOTE (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 (QUOTE 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 (QUOTE ACTIVE))
(NC.GetNoteCardFromStream NewCard TempStream
IndexLocs)
(NC.FixUpLinksInCardCopy NewCard CardHashArray
LinksHashArray
CurrentLinkLabels
NewLinkLabels
InterestedWindow
CopyExternalToLinksFlg
CrossFileLinkModePropList)
(if (NC.IsSubTypeOfP (NC.FetchType NewCard)
(QUOTE 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))))))
(NC.AbortSession
(LAMBDA (NoteFile InterestedWindow Don'tConfirmFlg QuietFlg)
(* DSJ: "29-Sep-87 00:59")
(* * Kill the current notecards session. Work lost since last checkpoint.)
(* * rht 7/14/85: Replaced the call to reset the main menu with call to NC.ResetMainMenu. Also took out redundant
reset of PSA.Database, since NC.ForceDatabaseClose is doing that.)
(* * fgh & rht 10/16/85 Update with new cacheing mechanism.)
(* * fkr 11/8/85 Updated to handle noteFile object and new CardID scheme.)
(* * kirk 20Jan86 Added Don'tCloseFlg to leave NoteFile open after done deleting changes.)
(* * kirk 23Jan86 Changed to use NC.AskYesOrNo)
(* * rht 7/2/86: No longer bugs you if no changes were made since last checkpoint. Removed Don'tCloseFlg arg and
added InterestedWindow arg.)
(* * rht 7/6/86: Now clears InterestedWindow of final truncating message.)
(* * rht 7/13/86: Added Don'tConfirmFlg and QuietFlg args. Note that Don'tConfirmFlg non-nil stops questioning of
user as to losing all changes.)
(* * kirk 11/17/86 Changed call on SETFILEINFO to pass stream instead of filename.)
(* * pmi 12/22/86 Made test for open notefile consistent with other NoteFile operations (ie. Checkpoint, Close))
(* * rht 2/19/87: Added DEL.PROCESS call to kill caching process.)
(* * rg 3/6/87 added NC.ProtectedSessionOperation wrapper)
(* * rht 3/25/87: Now calls NC.CoerceToInterestedWindow.)
(* * rg 3/31/87 changed ProtectedSessionOp to ProtectedNoteFileOp)
(* * pmi 8/7/87: Now asks for confirm no matter what work was done.)
(* * pmi 8/14/87: Now calls NC.NoticeNoteFile to make sure the file has been noticed.)
(* * pmi 8/18/87: No longer asks for confirm if notefile was open read-only.)
(* * dsj 9/23/87. Added BEFORE AND AFTER call to NC.RunCloseEvents)
(DECLARE (GLOBALVARS NC.MsgDelay))
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow NoteFile)))
(NC.ProtectedNoteFileOperation
NoteFile "Abort Session" InterestedWindow
(PROG ((Stream (fetch (NoteFile Stream) of NoteFile))
(FullFileName (fetch (NoteFile FullFileName) of NoteFile))
(LastChkptPtr (fetch (NoteFile CheckptPtr) of NoteFile))
EndPtr CardTotal NewBytes ReturnValue)
(if (NULL (ERSETQ (SETQ ReturnValue (NC.NoteFileOpenP NoteFile))))
then (SETQ ReturnValue (QUOTE OpenPFailed)))
(if (NULL ReturnValue)
then
(* * NoteFile is not open.)
(NC.PrintMsg InterestedWindow T "Can't abort a closed notefile."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T)
(RETURN NIL)
elseif (NOT (type? NoteFile ReturnValue))
then
(* * Error return from NoteFileOpenPFn)
(if (NULL (ERSETQ (NC.ReportError NIL (CONCAT "OpenP test on "
FullFileName
"failed because "
ReturnValue
(CHARACTER 13)
"OK to continue Abort. ↑ to abort Abort."))))
then (RETURN ReturnValue)))
(* * Delete the types and titles caching process if still alive. Have to do it now in order to make checking
operations that follow suitably efficient. Note its a bit too early since we can still cancel this close.
But any harm done is loss of speed if NoteFile remains open when close iss cancelled.)
(* * dsj added this call to NC.RunCloseEvents Exit on a return of DON'T)
(if (EQ (NC.RunCloseEvents NoteFile (QUOTE BEFORE))
(QUOTE DON'T))
then (RETURN NIL))
(DEL.PROCESS (fetch (NoteFile CachingProcess) of NoteFile))
(* * Removed old confirm question based on amount of stuff written past the checkpoint.)
(SETQ EndPtr (GETEOFPTR Stream))
(* * (SETQ NewBytes (IDIFFERENCE EndPtr LastChkptPtr)))
(* * This was in the if below: (OR (ZEROP NewBytes) Don'tConfirmFlg (NC.AskYesOrNo (CONCAT
"Do you wish to lose all changes since" (CHARACTER 13) "the last checkpoint (" NewBytes " bytes) of " FullFileName)
"--" "Yes" T InterestedWindow NIL T)))
(if (OR Don'tConfirmFlg (NC.ReadOnlyNoteFileP NoteFile)
(NC.AskYesOrNo (CONCAT "Do you wish to lose all changes since"
(CHARACTER 13)
"the open or last checkpoint of " FullFileName)
"--" "No" T InterestedWindow NIL T))
then (LET ((CardNumber 0)
(CardTotal (fetch (NoteFile HashArraySize) of NoteFile)))
(NC.MapCards NoteFile
(FUNCTION (LAMBDA (Card)
(LET (Win)
(SETQ CardNumber (ADD1 CardNumber))
(OR QuietFlg (COND
((ZEROP (IREMAINDER CardNumber 100))
(NC.PrintMsg InterestedWindow T
"Quitting from active cards ... "
(CHARACTER 13)
"Processing item number "
CardNumber " out of "
CardTotal "."
(CHARACTER 13)))))
(COND
((NC.ActiveCardP Card)
(SETQ Win (NC.FetchWindow Card))
(NC.AbortCard Card QuietFlg)
(COND
(Win (bind (Process ←(WINDOWPROP
Win
(QUOTE PROCESS)))
until (OR (NULL Process)
(PROCESS.FINISHEDP
Process))
do (BLOCK))
(CLOSEW Win))))))))))
(COND
((LESSP LastChkptPtr EndPtr)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Truncating file "
FullFileName " ..."))
(COND
((NOT (SETFILEINFO Stream (QUOTE LENGTH)
LastChkptPtr))
(NC.PrintMsg InterestedWindow NIL "Couldn't truncate "
FullFileName "." (CHARACTER 13))))))
(NC.ResetNoteFileInterface NoteFile)
(NC.ForceDatabaseClose NoteFile)
(NC.NoticeNoteFile NoteFile)
(* * added this call to NC.RunCloseEvents dsj)
(if (EQ (NC.RunCloseEvents NoteFile (QUOTE AFTER))
(QUOTE DON'T))
then (RETURN NIL)))
(NC.ClearMsg InterestedWindow T)))))
(NC.OpenNoteFile
(LAMBDA (NoteFileOrFileName Don'tCacheTypesAndTitlesFlg Don'tCreateFlg ConvertNoConfirmFlg
Don'tCreateArrayFlg Can'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg InterestedWindow PublicOrPrivate MenuPosition
QuietFlg ReadOnlyFlg Don'tCheckForTruncationFlg Don'tCheckVersionFlg)
(* pmi: "17-Dec-87 12:30")
(* * fgh 5/23/86 Renamed to NC.OpenNoteFile from NC.OpenDatabaseFile. Total revamp to implement device vector.)
(* * kef 7/18/86: Inserted a call to stuff the UID into the NoteFile because BuildHashArray needed it.)
(* * kef 7/21/86: Moved up the install of the NoteFile into the NoteFileHashArray to before the building of the
NoteFile's hash array. The reason is that the remote multi client build hash array function needs to get a list of
UIDs, and in order to do this, it needs to grab a Courier stream for the NoteFile given only the UID.
It can only do this if the UID is registered in the NoteFilesHashArray.)
(* * fgh 8/31/86 Updated to account for changes made to system since 5/23/86 revamp. Changes reimplemented include:
(fgh 6/8/86 Added code to insure that two files with SameUIDP would never be open at once.)
(fgh 6/25/86 Added contention locks -- NC.ProtectedNoteFileOperation, Don'tCheckOperationInProgressFlg etc.)
(fgh 6/27/86 Added MenuPsotion arg to pass to SetUpNoteFileInterface) (kirk 15Jul86 Added call to
NC.SetUpNoteFileInterface if already open))
(* * fgh 9/1/86 Reimplemented ReadOnly NoteFile open.)
(* * fgh 9/4/86 Put in default for NoteFilesHashArray which is NC.NoteFilesHashArray)
(* * kirk/rht 8/29/86: Now resets Name after conversion from version 2 to version3.)
(* * rht 10/29/86: Changed "aborted" to "canceled" in message.)
(* * rht 10/31/86: Added Don'tCheckForTruncationFlg arg.)
(* * rht&pmi 11/21/86: Took away the protection from around the AFTER call to open events fns.)
(* * pmi 12/12/86: Added InterestedWindow argument to NC.SetUpNoteFileInterface so that it can print a prompt to
the user about placing the NoteFile menu.)
(* * rg 3/4/87 Added NC.ProtectedSessionOperation wrapper, removed Don'tCheckOperationsInProgressFlg)
(* * rht 3/25/87: Now calls NC.CoerceToInterestedWindow.)
(* * pmi 3/31/87: Moved line of code which sets the ReadOnlyFlg to just after the test for an open notefile.
Otherwise, a notefile opened read-only could be changed to one opened normally.)
(* * rht 4/2/87: Now passes InterestedWindow to opennotefilefns.)
(* * rg 4/2/87 enlarged scope of NC.ProtectedNoteFileOperation)
(* * RG 4/3/87 replaced missing InterestedWindow arg to OpenNoteFileFn)
(* * pmi 5/19/87: Removed NoteFilesHashArray argument. Replaced call to NC.StoreNoteFileInHashArray with
NC.NoticeNoteFile in general cleanup.)
(* * pmi 5/20/87: Moved the open test up to almost the beginning of the function.)
(* * pmi 5/29/87: Deleted extra InterestedWindow argument to NC.ProtectedNoteFileOperation.
Added call to NC.RemoveAccessToNoteFile to "unnotice" this notefile if the file does not exist, and remove its
icon, if it has one. If InterestedWindow is the window for this NoteFile's interface, then change it to
NC.NoteCardsIconWindow.)
(* * pmi 6/3/87: Added check and warning for filenames which do not have the .notefile extension and which have not
yet been noticed (operated on) by NoteCards.)
(* * rht&pmi 6/4/87: Added TempInterestedWindow var to use until real InterestedWindow can be computed.)
(* * rht 6/8/87: Fixed what happens for notefiles with bad headers.)
(* * pmi 6/24/87: Added "(Highest version)" to question about opening highest version of a file.
Added Don'tCheckVersionFlg for Create and Compact, which have already figured out the correct version.)
(* * pmi 12/17/87: Added Don'tCreateInterfaceFlg argument to NC.SetUpNoteFileInterface so that esisting notefile
icons will be updated properly when the Don'tCreateInterfaceFlg is T, as suggested by dsj.)
(DECLARE (GLOBALVARS NC.OpenNoteFileFns NC.LastNoteFileOpened))
(* * NOTE: Session lock turns into NoteFile lock after NoteFile is created)
(PROG ((TempInterestedWindow (OR InterestedWindow (NC.CoerceToInterestedWindow
NoteFileOrFileName)))
NoteFile FileName NewerFileName OldVersion NewVersion NoteFileMenu ReturnValue
CriticalUIDs)
(* * Figure out the name of the file containing the NoteFile)
(if (NULL (SETQ FileName (if (type? NoteFile NoteFileOrFileName)
then (fetch (NoteFile FullFileName) of
NoteFileOrFileName)
elseif NoteFileOrFileName
else (NC.DatabaseFileName
"Name of NoteFile to open:"
" -- " T NIL NIL
TempInterestedWindow))))
then (RETURN NIL))
(* * Check for the .NoteFile extension if this notefile has not been noticed by NoteCards.)
(if (AND (NEQ (U-CASE (FILENAMEFIELD FileName (QUOTE EXTENSION)))
(QUOTE NOTEFILE))
(NOT (NC.NoteFileNoticedP FileName)))
then (NC.PrintMsg InterestedWindow T FileName
" does not have a .NOTEFILE extension."
(CHARACTER 13))
(if (NULL (NC.AskYesOrNo (CONCAT "Are you sure you want to open "
FileName " as a NoteFile?")
" -- " "No" NIL InterestedWindow T NIL))
then (NC.ClearMsg InterestedWindow T)
(RETURN NIL)))
(* * If this is an open NoteFIle, just bring up its menu.)
(if (NC.NoteFileOpenP FileName)
then (NC.SetUpNoteFileInterface (NC.NoteFileFromFileName FileName)
MenuPosition TempInterestedWindow
Don'tCreateInterfaceFlg)
(NC.ClearMsg TempInterestedWindow T)
(* bring up or create notefile icon if needed)
(RETURN NIL))
(* * Check for higher version of same notefile)
(if (AND (NOT Don'tCheckVersionFlg)
(SETQ OldVersion (FILENAMEFIELD FileName (QUOTE VERSION)))
(SETQ NewVersion (FILENAMEFIELD (SETQ NewerFileName
(FULLNAME (PACKFILENAME
(QUOTE VERSION)
NIL
(QUOTE BODY)
FileName)))
(QUOTE VERSION)))
(LESSP OldVersion NewVersion))
then
(* * Notify user)
(NC.PrintMsg TempInterestedWindow T "A higher version of " FileName
" exists."
(CHARACTER 13))
(* * Open the version the user requests.)
(if (NC.AskYesOrNo (CONCAT "Open " NewerFileName
" instead? (Highest version)")
" -- " "No" NIL TempInterestedWindow T NIL)
then (SETQ FileName NewerFileName)
(SETQ NoteFileOrFileName (NC.NoteFileFromFileName FileName))
(if (SETQ NoteFileMenu (NC.GetNoteFileMenu FileName))
then (NC.SetNoteFileMenu NoteFileOrFileName NoteFileMenu))))
(* * Create a NoteFile object or use existing notefile object if there is one for this file name.)
(SETQ NoteFile (if (type? NoteFile NoteFileOrFileName)
then NoteFileOrFileName
else (OR (NC.NoteFileFromFileName FileName)
(create NoteFile))))
(replace (NoteFile FullFileName) of NoteFile with FileName)
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow NoteFile)))
(RETURN
(NC.ProtectedNoteFileOperation
NoteFile "Open NoteFile" InterestedWindow
(PROG NIL
(* * Figure out the appropriate device vector from the file name.)
(NC.InstallDeviceVectorInNoteFile NoteFile PublicOrPrivate)
(* * Moved this replace to after test for open notefile. Otherwise, if notefile is open read-only, it well be
changed to regular open.)
(replace (NoteFile ReadOnlyFlg) of NoteFile with ReadOnlyFlg)
(* * Notify user.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Opening NoteFile: "
FileName " ..." (CHARACTER 13)))
(SETQ ReturnValue
(PROG NIL
(* * Run through OpenNoteFileFns with param of BEFORE. Exit if any returns DON'T)
(if (for Function in NC.OpenNoteFileFns
thereis (OR (EQ Function (QUOTE DON'T))
(EQ (QUOTE DON'T)
(APPLY* Function FileName NoteFile
(QUOTE BEFORE)
InterestedWindow))))
then (if (WINDOWP InterestedWindow)
then (NC.PrintMsg InterestedWindow NIL
"Open canceled for NoteFile "
FileName "." (CHARACTER
13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T))
(RETURN))
(* * Call the device specific OpenNoteFileFn, which returns a list of special UIDs)
(if (NULL (ERSETQ (SETQ ReturnValue
(APPLY* (fetch (NoteFile
OpenNoteFileFn)
of NoteFile)
NoteFile InterestedWindow
Don'tCheckForTruncationFlg))))
then (SETQ ReturnValue (QUOTE NoteFileOpenFailed)))
(* * Process error returns from the OpenNoteFileFn)
(if (NOT (LITATOM ReturnValue))
then
(* * OpenNoteFileFn returned correctly)
(SETQ CriticalUIDs ReturnValue)
else
(* * Error, process it.)
(SETQ ReturnValue
(OR (SELECTQ
ReturnValue
(NoteFileNotFound (NC.RemoveAccessToNoteFile
NoteFile)
(SETQ InterestedWindow
(NC.CoerceToInterestedWindow
InterestedWindow))
(NC.ProcessNoteFileNotFoundError
NoteFile
Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg ConvertNoConfirmFlg
Don'tCreateArrayFlg
Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg
InterestedWindow PublicOrPrivate
MenuPosition QuietFlg ReadOnlyFlg
Don'tCheckForTruncationFlg))
(NoteFileNeedsConversion (
NC.ProcessNoteFileNeedsConversionError
NoteFile
Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg
ConvertNoConfirmFlg
Don'tCreateArrayFlg
Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg
InterestedWindow
PublicOrPrivate
MenuPosition QuietFlg
ReadOnlyFlg
Don'tCheckForTruncationFlg))
(NoteFileNeedsTruncation (
NC.ProcessNoteFileNeedsTruncationError
NoteFile
Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg
ConvertNoConfirmFlg
Don'tCreateArrayFlg
Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg
InterestedWindow
PublicOrPrivate
MenuPosition QuietFlg
ReadOnlyFlg
Don'tCheckForTruncationFlg))
(NoteFileAlreadyOpen
(ERSETQ (NC.ReportError
NIL
(CONCAT (fetch (NoteFile
FullFileName)
of NoteFile)
" is already open for exclusive access. Open failed."))))
(NoteFileOpenFailed
(ERSETQ (NC.ReportError
NIL
(CONCAT "Open of "
(fetch (NoteFile
FullFileName)
of NoteFile)
" failed for unknown reason."))
))
((NoteFileHeaderBad BadNextIndexNum BadHashArraySize
BadCheckptPtr BadNextLinkNum)
(ERSETQ (NC.ReportError
NIL
(CONCAT "Header of NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile)
" is bad: " ReturnValue
". Contact a NoteCards wizard."))))
(PROGN (ERSETQ (NC.ReportError NIL
(CONCAT
"Unknown error code ("
ReturnValue
") returned by OpenNoteFileFn for NoteFile "
FileName)))))
ReturnValue))
(* * notify the user. if there's been a problem)
(if (AND (NOT (type? NoteFile ReturnValue))
(WINDOWP InterestedWindow))
then (NC.PrintMsg InterestedWindow NIL
"Open canceled for NoteFile "
FileName "." (CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T))
(* * return whatever the error processing returned.)
(RETURN ReturnValue))
(SETQ ReturnValue)
(* * Make sure there is no other open NF with this UID.)
(LET (NF)
(if (AND (SETQ NF (GETHASH (fetch (
NoteFileCriticalUIDs NoteFile) of CriticalUIDs)
NC.NoteFilesHashArray))
(NEQ (fetch (NoteFile FullFileName)
of NoteFile)
(fetch (NoteFile FullFileName)
of NF))
(NC.NoteFileOpenP NF))
then (FLASHW PROMPTWINDOW)
(NC.PrintMsg PROMPTWINDOW T "Couldn't open "
FileName (CHARACTER 13)
"because "
(fetch (NoteFile FullFileName)
of NF)
" is already open "
(CHARACTER 13)
"and has the same UID.")
(NC.CloseNoteFile NoteFile InterestedWindow T)
(RETURN NIL)))
(* * If needed, build a hash array by calling the device specific BuilHashArrayFn.)
(replace (NoteFile UID) of NoteFile with (fetch
(
NoteFileCriticalUIDs NoteFile) of CriticalUIDs))
(* * Store this NoteFile object in the appropriate NoteFile hash array)
(NC.NoticeNoteFile NoteFile)
(if (NOT Don'tCreateArrayFlg)
then
(OR QuietFlg (NC.PrintMsg InterestedWindow T
"Opening NoteFile: "
FileName
(CHARACTER 13)
"Building index array ..."
(CHARACTER 13)))
(if
(OR (NULL (ERSETQ (SETQ ReturnValue
(APPLY*
(fetch (NoteFile
BuildHashArrayFn)
of NoteFile)
NoteFile QuietFlg
InterestedWindow
(CONCAT "Opening NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile)
(CHARACTER 13))))))
(NOT (type? NoteFile ReturnValue)))
then
(* * Error during building of hash array)
(ERSETQ (NC.ReportError
NIL
(CONCAT
"Build Hash Array failed for NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile)
" because " ReturnValue)))
(RETURN)))
(* * Set up critical UIDs in NoteFile object using the values returned from OpenNoteFileFn.)
(NC.InstallCriticalUIDsInNoteFile NoteFile CriticalUIDs)
(* * if needed, cache the special cards)
(if (NOT Don'tGetSpecialCardsFlg)
then (NC.GetSpecialCards NoteFile QuietFlg InterestedWindow
(CONCAT "Opening NoteFile: "
(fetch (NoteFile
FullFileName)
of NoteFile)
(CHARACTER 13))))
(* * If needed, start the titles and types caching process)
(if (NOT Don'tCacheTypesAndTitlesFlg)
then (replace (NoteFile CachingProcess) of NoteFile
with (ADD.PROCESS (LIST (FUNCTION
NC.CacheTypesAndTitles)
NoteFile))))
(* * If needed, open up a NoteFile interface.)
(NC.SetUpNoteFileInterface NoteFile MenuPosition InterestedWindow
Don'tCreateInterfaceFlg)
(* * Record this as the last NF opened.)
(SETQ NC.LastNoteFileOpened NoteFile)
(RETURN NoteFile)))
(if (type? NoteFile ReturnValue)
then
(* * Run through OpenNoteFIleFns with param of AFTER. Stop if any returns DON'T)
(for Function in NC.OpenNoteFileFns
thereis (EQ (QUOTE DON'T)
(APPLY* Function FileName NoteFile
(QUOTE AFTER)
InterestedWindow)))
(* * Go home, returning NoteFile)
(if (NULL QuietFlg)
then (NC.PrintMsg InterestedWindow T "Opening NoteFile: "
FileName (CHARACTER 13)
"Done."
(CHARACTER 13))
(NC.ClearMsg InterestedWindow T))
(RETURN NoteFile)
else
(* * Bail out if open was unsuccessful.)
(RETURN NIL))))))))
(NC.ProcessNoteFileNotFoundError
(LAMBDA (NoteFile Don'tCacheTypesAndTitlesFlg Don'tCreateFlg Convertw/oConfirmFlg
Don'tCreateArrayFlg Can'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg InterestedWindow PublicOrPrivate MenuPosition QuietFlg
ReadOnlyFlg Don'tCheckForTruncationFlg)
(* DSJ: " 6-Nov-87 02:21")
(* * NoteFile couldnot be found when an attempt was made to open it. Find out if the user wants to create it.)
(* * fgh 5/23/86 First created.)
(* * fgh 9/1/86 Updated args to match NC.OpenNoteFIle.)
(* * rht 10/31/86: Added Don'tCheckForTruncationFlg arg.)
(* * pmi 5/28/87: Removed NoteFilesHashArray argument.)
(* * dsj. 11/5/87. Now correctly passes a multitude of args to NC.CreateNoteFile.)
(if QuietFlg
then
(* * If QuietFlg is set, then we'll just have to send back a error notification.)
(QUOTE NoteFileNotFound)
else
(* * Otherwise, we can interact with the user.)
(LET (NewFileName)
(* * Notify user of the error)
(NC.PrintMsg InterestedWindow T "Could not find NoteFile " (fetch (NoteFile
FullFileName)
of NoteFile)
(CHARACTER 13))
(* * If the user wants to create the file, then create it and try the open again.)
(if (AND (NULL Don'tCreateFlg)
(NC.AskYesOrNo (CONCAT "Do you want to create "
(fetch (NoteFile FullFileName)
of NoteFile))
" -- " "Y" NIL InterestedWindow T NIL))
then (if (CAR (ERSETQ (SETQ NewFileName (NC.CreateNoteFile
NoteFile NIL NIL InterestedWindow
(CONCAT "Opening NoteFile" (CHARACTER
13))
QuietFlg PublicOrPrivate NIL ReadOnlyFlg
Don'tCreateInterfaceFlg MenuPosition))))
then (NC.OpenNoteFile NoteFile Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg Convertw/oConfirmFlg
Don'tCreateArrayFlg Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg InterestedWindow
PublicOrPrivate MenuPosition QuietFlg
ReadOnlyFlg Don'tCheckForTruncationFlg))
else (QUOTE NoteFileNotFound))))))
(NC.NoteFileNoticedP
(LAMBDA (NoteFileOrFileName) (* pmi: "18-Dec-87 10:17")
(* * pmi 6/2/87: Created to check if notefile has been noticed by NoteCards.)
(* * pmi 12/18/87: Changed the global var NC.NoticedNoteFileNames to NCP.NoticedNoteFileNames to make it available
in the programmer's interface.)
(DECLARE (GLOBALVARS NCP.NoticedNoteFileNames))
(LET (FullFileName NoteFile)
(if (type? NoteFile NoteFileOrFileName)
then (SETQ NoteFile NoteFileOrFileName)
(SETQ FullFileName (fetch (NoteFile Menu) of NoteFile))
elseif (SETQ FullFileName (FULLNAME NoteFileOrFileName))
then (SETQ NoteFile (NC.NoteFileFromFileName FullFileName)))
(OR (MEMBER NoteFile (NC.ListOfNoteFiles))
(MEMBER FullFileName NCP.NoticedNoteFileNames)))))
(NC.NoticeNoteFileName
(LAMBDA (NoteFileOrFileName) (* pmi: "18-Dec-87 10:27")
(* * pmi 5/14/87: Created to keep track of noticed NoteFiles)
(* * pmi 5/21/87: Now creates a menu item bitmap for this notefile.)
(* * pmi 8/13/87: Overhauled stuff for menu of noticed notefiles.)
(* * pmi 12/18/87: Changed the global var NC.NoticedNoteFileNames to NCP.NoticedNoteFileNames to make it available
in the programmer's interface.)
(DECLARE (GLOBALVARS NCP.NoticedNoteFileNames NC.NoticedNoteFilesMenu))
(LET (FullFileName NoteFile)
(if (type? NoteFile NoteFileOrFileName)
then (SETQ FullFileName (fetch (NoteFile FullFileName) of NoteFileOrFileName))
(SETQ NoteFile NoteFileOrFileName)
else (SETQ FullFileName (FULLNAME NoteFileOrFileName))
(SETQ NoteFile (NC.NoteFileFromFileName FullFileName)))
(* * If the filename is a valid file, add it to the list of noticed files. If the filename is not a valid file,
remove it from the list of noticed files. If the resulting list is empty, set it to NIL (DREMOVE can't set a list
to NIL))
(if FullFileName
then (if NCP.NoticedNoteFileNames
then (MERGEINSERT FullFileName NCP.NoticedNoteFileNames T)
else (SETQ NCP.NoticedNoteFileNames (MERGEINSERT FullFileName
NCP.NoticedNoteFileNames T)))
(SELECTQ (GETPROP FullFileName (QUOTE LastKnownStatus))
(OPEN (if (NULL (NC.NoteFileOpenP NoteFile))
then (PUTPROP FullFileName (QUOTE LastKnownStatus)
(QUOTE CLOSED))
(SETQ NC.NoticedNoteFilesMenu NIL)))
(CLOSED (if (NC.NoteFileOpenP NoteFile)
then (PUTPROP FullFileName (QUOTE LastKnownStatus)
(QUOTE OPEN))
(SETQ NC.NoticedNoteFilesMenu NIL)))
(PROGN (if (NC.NoteFileOpenP NoteFile)
then (PUTPROP FullFileName (QUOTE LastKnownStatus)
(QUOTE OPEN))
else (PUTPROP FullFileName (QUOTE LastKnownStatus)
(QUOTE CLOSED)))
(SETQ NC.NoticedNoteFilesMenu NIL)))
(* * Constuct menu items for this notefile.)
(NC.CreateNoteFileMenuItems FullFileName)
else (if (DREMOVE NoteFileOrFileName NCP.NoticedNoteFileNames)
else (SETQ NCP.NoticedNoteFileNames NIL))))))
(NC.RemoveNoteFileName
(LAMBDA (NoteFileOrFileName) (* pmi: "18-Dec-87 10:34")
(* * pmi 5/19/87: Created to keep track of noticed NoteFiles)
(* * pmi 8/13/87: Added trashing of NC.NoticedNoteFilesMenu to force its recomputation.)
(* * pmi 12/18/87: Changed the global var NC.NoticedNoteFileNames to NCP.NoticedNoteFileNames to make it available
in the programmer's interface.)
(DECLARE (GLOBALVARS NCP.NoticedNoteFileNames NC.NoticedNoteFilesMenu))
(LET (FullFileName)
(if (type? NoteFile NoteFileOrFileName)
then (SETQ FullFileName (fetch (NoteFile FullFileName) of NoteFileOrFileName))
else (SETQ FullFileName (OR (FULLNAME NoteFileOrFileName)
NoteFileOrFileName)))
(* * If the filename is a valid or invalid file, remove it from the list of noticed files. If the resulting list is
empty, set it to NIL (DREMOVE can't set a list to NIL))
(if (DREMOVE FullFileName NCP.NoticedNoteFileNames)
else (SETQ NCP.NoticedNoteFileNames NIL))
(* * Trash the menu of noticed notefiles so that it will be recomputed.)
(SETQ NC.NoticedNoteFilesMenu NIL))))
)
(* * Changed in NCINTERFACE)
(DEFINEQ
(NC.BringUpNoteCardsIcon
(LAMBDA (Position Style) (* pmi: " 8-Dec-87 15:24")
(* * Either flash existing NoteCards icon or make a new one.)
(* * fgh 6/7/86 Added Position arg to pass to NC.MakeWindow)
(* * kirk 1Jul86 Changed FLASHW to FLASHWINDOW)
(* * pmi 3/18/87: Added Style argument to be passed to NC.MakeNoteCardsIcon for selection of session icon style)
(* * pmi 12/8/87: Added check for NC.NoteCardsIconWindow being bound. Also, now returns NC.NoteCardsIconWindow.)
(DECLARE (GLOBALVARS NC.NoteCardsIconWindow))
(if (AND (BOUNDP (QUOTE NC.NoteCardsIconWindow))
(WINDOWP NC.NoteCardsIconWindow))
then (if Position
then (MOVEW NC.NoteCardsIconWindow Position))
(FLASHWINDOW NC.NoteCardsIconWindow)
else (SETQ NC.NoteCardsIconWindow (NC.MakeNoteCardsIcon Position Style)))
NC.NoteCardsIconWindow))
(NC.AskNoteCardType
(LAMBDA (MainMenuOrRegion) (* pmi: "31-Dec-87 13:32")
(* Ask user to choose a note card type)
(* * rht 1/12/85: Now takes an optional Region argument dictating where to place the NoteCardTypeMenu.
If NIL, then uses MainMenu.)
(* * fgh 11/16/85 Updated to take a MainMenu arg in place of using the NC.MainMenu globalvar.)
(* * pmi 3/20/87: Changed fields of NC.NoteCardTypeMenu: CENTERFLG to T, MENUFONT to NC.MenuFont, changed title
from "Type?" to "Card Types")
(* * pmi 12/31/87: Changed ManinMenuOrRegion to MainMenuOrRegion.)
(DECLARE (GLOBALVARS NC.NoteCardTypeMenu NC.MenuFont))
(PROG (W Z)
(OR (AND (BOUNDP (QUOTE NC.NoteCardTypeMenu))
(type? MENU NC.NoteCardTypeMenu))
(SETQ NC.NoteCardTypeMenu (create MENU
ITEMS ←(NC.ListOfCardTypes T)
CENTERFLG ← T
TITLE ← "Card Types"
MENUFONT ← NC.MenuFont
ITEMHEIGHT ←(IPLUS (FONTPROP
NC.MenuFont
(QUOTE HEIGHT))
1))))
(replace MENUPOSITION of NC.NoteCardTypeMenu
with (COND
((REGIONP MainMenuOrRegion)
(CONS (fetch (REGION LEFT) of MainMenuOrRegion)
(IPLUS (fetch (REGION BOTTOM) of MainMenuOrRegion)
(fetch (REGION HEIGHT) of MainMenuOrRegion)
(IMINUS (fetch (MENU IMAGEHEIGHT) of
NC.NoteCardTypeMenu)))))
(T (CONS (IPLUS (fetch (REGION LEFT) of (SETQ Z
(WINDOWPROP (WFROMMENU
MainMenuOrRegion)
(QUOTE
REGION))))
(fetch (REGION LEFT)
of (SETQ W
(MENUITEMREGION
(CAR (NTH (fetch (MENU ITEMS)
of MainMenuOrRegion)
1))
MainMenuOrRegion))))
(IPLUS (fetch (REGION BOTTOM) of Z)
(fetch (REGION TOP) of W)
(IMINUS (fetch (MENU IMAGEHEIGHT) of
NC.NoteCardTypeMenu)))))
))
(RETURN (MENU NC.NoteCardTypeMenu)))))
(NC.SetUpNoteFileInterface
(LAMBDA (NoteFile Position InterestedWindow Don'tCreateInterfaceFlg)
(* pmi: "17-Dec-87 12:13")
(* * Create the NoteCards control menu for a NoteFile)
(* * kirk 13Jan85 Decreased the size of the NoteFile Menu)
(* * fgh 1/22/86 Fixed the ghost box size when position menu.)
(* * rht 5/6/86: Now restores the menu's WhenSelectedFn and ungrays its items if already existed.)
(* * fgh 6/27/86 Added position argument)
(* * rht 7/5/86: Now shades NewCards if readonly notefile.)
(* * fgh 7/6/86 Will now set up menu correctly even if NF is closed.)
(* * rht 7/13/86: Was ignoring the Position arg. No longer.)
(* * rht 11/20/86: Changed name from ShowBox to ShowCards.)
(* * pmi 12/12/86: Added InterestedWindow argument so that we can print a prompt to the user about placing a newly
created NoteFile menu.)
(* * pmi 3/20/87: Removed WhenSelectedFn when overhauling to have NewCards and ShowCards middlebutton menus appear
when buttoned DOWN, instead of after the button comes back up. Everything is now done in the ButtonEventFn.)
(* * pmi 5/6/87: Moved prompt for position of icon to better place. Also added MENUOFFSET to NoteFile menu for
Lyric.)
(* * pmi 5/19/87: Now stores the menu as a property of the fullfilename of the notefile. We might lose our pointer
to the notefile object if another one gets created with the same UID, but we would like to keep a pointer to the
menu.)
(* * pmi 5/28/87: Now returns the NoteFile Interface window.)
(* * pmi 12/17/87: Added Don'tCreateInterfaceFlg argument in response to suggestion by dsj.
Now can be called to update the notefile interface and won't automatically create a new one if it doesn't already
exist.)
(LET ((Font (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE BOLD)))
(TitleFont (FONTCREATE (QUOTE HELVETICA)
12
(QUOTE BOLD)))
NoteFileMenuWindow NoteFileMenu FullFileName) (* Main Menu)
(SETQ FullFileName (fetch (NoteFile FullFileName) of NoteFile))
(if (SETQ NoteFileMenu (OR (NC.GetNoteFileMenu NoteFile)
(NC.GetNoteFileMenu FullFileName)))
then
(* * No longer need WHENSELECTEDFN)
(* * (replace (MENU WHENSELECTEDFN) of NoteFileMenu with (if (NC.NoteFileOpenP NoteFile) then
(FUNCTION NC.NoteFileMenuWhenSelectedFn) else (FUNCTION NC.ClosedNoteFileMenuWhenSelectedFn))))
(replace (MENU TITLE) of NoteFileMenu with (CONCAT (if (
NC.ReadOnlyNoteFileP
NoteFile)
then "RO: "
else "")
(FILENAMEFIELD
FullFileName
(QUOTE NAME))
";"
(FILENAMEFIELD
FullFileName
(QUOTE VERSION)))
)
(replace (MENU IMAGE) of NoteFileMenu with NIL)
(* KLUDGE. Fetching the image height forces the menu
package to recompute the menu image.)
(fetch (MENU IMAGEHEIGHT) of NoteFileMenu)
(AND (WFROMMENU NoteFileMenu)
(REDISPLAYW (WFROMMENU NoteFileMenu)))
else
(* * Removed this menu field from following menu: (WHENSELECTEDFN ← (if (NC.NoteFileOpenP NoteFile) then
(FUNCTION NC.NoteFileMenuWhenSelectedFn) else (FUNCTION NC.ClosedNoteFileMenuWhenSelectedFn))))
(SETQ NoteFileMenu (create MENU
ITEMS ←(QUOTE ((NewCards NIL
"Create a new Text card (left button) or other card type (middle button).")
(ShowCards NIL
"Bring up one of the special cards.")))
WHENSELECTEDFN ←(FUNCTION NILL)
CENTERFLG ← T
MENUBORDERSIZE ← 1
MENUOUTLINESIZE ← 2
MENUCOLUMNS ← 2
MENUFONT ← Font
TITLE ←(CONCAT (if (NC.ReadOnlyNoteFileP
NoteFile)
then "RO: "
else "")
(FILENAMEFIELD FullFileName
(QUOTE NAME))
";"
(FILENAMEFIELD FullFileName
(QUOTE VERSION)))
ITEMHEIGHT ←(IPLUS 6 (FONTPROP Font
(QUOTE HEIGHT)))
ITEMWIDTH ←(IPLUS (STRINGWIDTH (QUOTE NewCards)
Font)
10)
MENUTITLEFONT ← TitleFont
MENUOFFSET ←(CONS 0 0))))
(for Item in (fetch (MENU ITEMS) of NoteFileMenu)
do (SHADEITEM Item NoteFileMenu (if (NC.NoteFileOpenP NoteFile)
then WHITESHADE
else GRAYSHADE)))
(* Shade NewCards if readonly notefile.)
(if (NC.ReadOnlyNoteFileP NoteFile)
then (for Item in (fetch (MENU ITEMS) of NoteFileMenu)
when (EQ (CAR Item)
(QUOTE NewCards))
do (SHADEITEM Item NoteFileMenu GRAYSHADE)))
(if (WINDOWP (SETQ NoteFileMenuWindow (WFROMMENU NoteFileMenu)))
then (FLASHWINDOW NoteFileMenuWindow)
else
(* * Don't create a new NoteFile interface if we were asked not to.)
(OR Don'tCreateInterfaceFlg (SETQ NoteFileMenuWindow
(ADDMENU NoteFileMenu NIL (if Position
elseif (GETMENUPROP NoteFileMenu
(QUOTE OldPosition))
else
(* Prompt the user to place the new notefile menu)
(NC.PrintMsg InterestedWindow T
"Please place the menu for notefile "
FullFileName)
(SETQ Position
(GETBOXPOSITION
(fetch (REGION WIDTH)
of (MENUREGION NoteFileMenu)
)
(fetch (REGION HEIGHT)
of (MENUREGION NoteFileMenu)
)))
(NC.ClearMsg InterestedWindow T)
Position)))))
(if NoteFileMenuWindow
then (WINDOWPROP NoteFileMenuWindow (QUOTE NoteFile)
NoteFile)
(replace (NoteFile Menu) of NoteFile with NoteFileMenu)
(PUTPROP FullFileName (QUOTE Menu)
NoteFileMenu)
(WINDOWPROP NoteFileMenuWindow (QUOTE RESHAPEFN)
(QUOTE DON'T))
(WINDOWPROP NoteFileMenuWindow (QUOTE BUTTONEVENTFN)
(FUNCTION NC.NoteFileIconButtonEventFn))
(WINDOWPROP NoteFileMenuWindow (QUOTE SHRINKFN)
(QUOTE DON'T))
(WINDOWPROP NoteFileMenuWindow (QUOTE SCROLLFN)
NIL)
(WINDOWPROP NoteFileMenuWindow (QUOTE NOSCROLLBARS)
T)
(* * Make sure default menu WhenSelectedFn is not called)
(WINDOWPROP NoteFileMenuWindow (QUOTE CURSORINFN)
NIL)
(WINDOWPROP NoteFileMenuWindow (QUOTE CURSOROUTFN)
NIL)
(WINDOWPROP NoteFileMenuWindow (QUOTE CURSORMOVEDFN)
NIL)
(* *)
(WINDOWADDPROP NoteFileMenuWindow (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (Window)
(PUTMENUPROP (CAR (WINDOWPROP Window (QUOTE MENU)))
(QUOTE OldPosition)
(WINDOWPOSITION Window)))))
(NC.MoveWindowOntoScreen NoteFileMenuWindow))
NoteFileMenuWindow)))
(NC.ListOfNoteFilesMenu
(LAMBDA (IncludeNewNoteFileFlg ShowOnlyOpenNFsFlg InterestedWindow Operation)
(* pmi: "18-Dec-87 10:04")
(* * Bring up a menu of all notefiles found in the notefiles hash array. Also allow user to open a new notefile.)
(* * kirk 23Jan86 Added AskYesOrNo and InterestedWindow parameter)
(* * fgh 6/8/86 Added check to make sure NoteFile is open if it has a menu on the screen. Needed to handle case of
liongering NF menus.)
(* * fgh 6/24/86 Changed to be a general function rather than one specific for opening. Now just returns the chosen
name. Also, added IncludeNewNoteFileFlg and ShowOnlyOpenNFsFlg. Removed InterestedWindow arg.)
(* * fgh 6/27/86 Added InterestedWindow & Operation args and call to NC.DatabaseFileName.)
(* * pmi 12/4/86: Added version numbers to rootnames on list of known files. Also cleaned up help string for menu
items. It was giving a bogus message about opening the selected file, even though this function is used for many
operations and not just for Open.)
(* * pmi 2/18/87: Added GLOBALVARS declaration for NC.MenuFont)
(* * pmi 5/14/87: Changed symbol for open notefile to o. Now uses NCP.NoticedNoteFileNames instead of hash array to
build menu. Returns a NoteFile name instead of a NoteFile object.)
(* * pmi 12/18/87: Changed the global var NC.NoticedNoteFileNames to NCP.NoticedNoteFileNames to make it available
in the programmer's interface.)
(DECLARE (GLOBALVARS NC.MenuFont NCP.NoticedNoteFileNames))
(LET (Menu Items Result)
(SETQ Items (BQUOTE (,@(for NoteFileName in NCP.NoticedNoteFileNames
bind NoteFile Stream RootName
when (PROGN (SETQ NoteFile (NC.NoteFileFromFileName
NoteFileName))
(OR (AND (EQ ShowOnlyOpenNFsFlg
(QUOTE CLOSED))
(NULL (NC.NoteFileOpenP
NoteFile)))
(NULL ShowOnlyOpenNFsFlg)
(NC.NoteFileOpenP NoteFile)))
collect (LIST (CONCAT
(if (NC.NoteFileOpenP NoteFile)
then
(* (if (WINDOWP (WFROMMENU
(fetch (NoteFile Menu) of NoteFile))) then "* " else
"$ "))
"o "
else " ")
(SUBSTRING (SETQ RootName
(PACKFILENAME
(QUOTE NAME)
(FILENAMEFIELD
NoteFileName
(QUOTE NAME))
(QUOTE VERSION)
(FILENAMEFIELD
NoteFileName
(QUOTE VERSION))))
1
(MIN 20 (NCHARS RootName))
))
NoteFileName
(CONCAT "Selects NoteFile " NoteFileName)))
,@(if IncludeNewNoteFileFlg
then (LIST (QUOTE ("-- Other NoteFile --"
(QUOTE NEW)
"Select some other notefile - you'll be prompted for the name.")))
else NIL))))
(SETQ Result (if (NULL Items)
then NIL
elseif (AND (EQ (LENGTH Items)
1)
(EQUAL (CADAR Items)
(QUOTE (QUOTE NEW))))
then (QUOTE NEW)
else (MENU (create MENU
ITEMS ← Items
TITLE ←(OR Operation "NoteFiles")
MENUFONT ← NC.MenuFont
ITEMHEIGHT ←(IPLUS (FONTPROP NC.MenuFont
(QUOTE HEIGHT))
1)))))
(if (EQ Result (QUOTE NEW))
then (SETQ Result (NC.DatabaseFileName (CONCAT "Name of NoteFile to "
(SUBSTRING Operation 1 -9)
(CHARACTER 13))
" -- " T T NIL InterestedWindow)))
Result)))
)
(* * New in NCINTERFACE)
(* * Was NC.NoticedNoteFileNames, which should be removed from NCINTERFACE coms.)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NCP.NoticedNoteFileNames)
)
(RPAQQ NCP.NoticedNoteFileNames NIL)
(* * Changed in NCLISTCARD)
(DEFINEQ
(NC.EvaluateListCardSubstance
(LAMBDA (CardOrList Message InterestedWindow ExitOnDontFlg)
(* pmi: "10-Dec-87 14:10")
(* * Evaluate the contents of a list card.)
(* * rht 4/2/87: Added InterestedWindow arg.)
(* * rht 4/19/87: Now clears InterestedWindow before printing.)
(* * dsj 11/5/87: Changed Card arg to CardOrList to allow lists to be passed in for the case where this fn is
called after the notefile has been closed and the card is no longer accessible. Now exits if any exprs return DON'T
if ExitOnDontFlg is non-NIL.)
(* * pmi 12/10/87: added dsj's changes; see above comments.)
(LET (CardEvents)
(SETQ CardEvents (if (LISTP CardOrList)
then CardOrList
else (NCP.CardSubstance CardOrList)))
(OR InterestedWindow (AND (NOT (LISTP CardOrList))
(SETQ InterestedWindow (NC.CoerceToInterestedWindow
CardOrList))))
(if Message
then (NC.PrintMsg InterestedWindow T Message))
(if ExitOnDontFlg
then (CAR (ERSETQ (if (for Item in CardEvents
thereis (EQ (CAR (ERRORSET Item))
(QUOTE DON'T)))
then (QUOTE DON'T))))
else (ERSETQ (for Item in CardEvents do (ERRORSET Item)))))))
)
(* * New in NCCARDS)
(DEFINEQ
(NC.CardsToDelete
(LAMBDA (Cards) (* pmi: "15-Jan-88 10:04")
(* * dsj 10/4/87: This fn checks each card's card type WhenDeletedFn to see if we can go ahead with the delete.
Return those cards for which it's okay to delete.)
(* * pmi 1/15/88: Changed to not return a card if its WhenDeletedFn returns (QUOTE ABORT))
(for Card in (MKLIST Cards) bind WhenDeletedFn collect Card
when (NOT (AND (SETQ WhenDeletedFn (GETPROP (NCP.CardType Card)
(QUOTE WhenDeletedFn)))
(EQ (U-CASE (APPLY* WhenDeletedFn Card))
(QUOTE ABORT)))))))
)
(* * Changed in NCCARDS)
(DEFINEQ
(NC.EditNoteCard
(LAMBDA (Card ReadOnly RegionOrPosition TypeSpecificArgs)
(* pmi: "30-Dec-87 15:57")
(* * Bring the already created NoteCard specified by ID onto the screen at Region or Position specified by
RegionOrPosition)
(* * fgh 11/11/85: Updated to handle new Card object.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * kirk 15May86 Added call to NC.AttachNoteFileName)
(* * rht 7/13/86: Added TypeSpecificArgs arg.)
(* * kef 7/16/86: Added NC.ObtainCardEditPermission.)
(* * kef 8/7/86: Added check to make sure that applying the EditFn worked. If not, then release those write locks,
thus keeping the writelock count consistent.)
(* * fgh 8/30/86 Converted APPLY* to NC.ApplyFn.)
(* * rht 10/6/86: Added checks before doing WINDOWPROP calls in case there was a recursive call to
NC.EditNoteCard.)
(* * rg 3/30/87 added NC.ProtectedCardOperation wrapper)
(* * rht 5/13/87: Added call to new NC.InstallCopyButtonEventFn.)
(* * dsj 9/22/87: Included check for valid card type of destination card.)
(* * rg 11/4/87 added ReadOnly arg)
(* * pmi 12/30/87: Added dsj's change; see comment above.)
(DECLARE (GLOBALVARS NC.ShowNoteFileOnCards))
(NC.ProtectedCardOperation Card "Edit NoteCard" NIL (RESETSAVE (CURSOR WAITINGCURSOR))
(LET ((NoteCardType (NC.RetrieveType Card))
(CardWindow (NCP.CardWindow Card)))
(if (NCP.CardTypeP NoteCardType)
then (PROG (Window Substance EditResult)
(COND
((AND (NC.ActiveCardP Card)
(NC.ObtainEditPermission Card))
(SETQ Substance (NC.FetchSubstance
Card)))
((NC.ObtainEditPermission Card)
(NC.GetNoteCard Card)
(SETQ Substance (NC.FetchSubstance
Card)))
(T (RETURN (NC.CardPartBusy
Card
(QUOTE (SUBSTANCE TOLINKS
GLOBALTOLINKS
PROPLIST)))))
)
(COND
((AND (SETQ EditResult
(ERSETQ (NC.ApplyFn EditFn Card
Substance
RegionOrPosition
TypeSpecificArgs)))
(WINDOWP (SETQ Window
(CAR EditResult))))
(WINDOWADDPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.QuitCard)
(QUOTE FIRST))
(OR (NC.CardP (WINDOWPROP
Window
(QUOTE
NoteCardObject)))
(WINDOWPROP Window (QUOTE
NoteCardObject)
Card))
(NC.InstallCopyButtonEventFn Window)
(if NC.ShowNoteFileOnCards
then (NC.AttachNoteFileName Window)
))
(T
(* At this point, we've obtain the write locks but the
edit failed, so we'd better release them)
(for CardPart
in (QUOTE (SUBSTANCE TOLINKS
GLOBALTOLINKS
PROPLIST))
do (NC.ApplyFn
ReleaseWritePermissionFn
Card CardPart))
(RETURN)))
(if ReadOnly
then (NC.ApplyFn MakeReadOnlyFn Card))
(RETURN Window))
else (if CardWindow
then (FLASHW CardWindow)
(NCP.PrintMsg CardWindow T
"Cannot open this card because card type definition "
NoteCardType " not found."
(CHARACTER 13)
"First redefine card type "
NoteCardType (CHARACTER
13))
else (NCP.PrintMsg InterestedWindow T
"Cannot open this card because card type definition "
NoteCardType " not found."
(CHARACTER 13)
"First redefine card type "
NoteCardType (CHARACTER
13))
(DISMISS 3000)
(NCP.ClearMsg InterestedWindow T)))))))
(NC.CardSaveFn
(LAMBDA (WindowOrID QuietFlg InterestedWindow OperationMsg)
(* pmi: "10-Dec-87 11:41")
(* * rht 2/1/85: New function for saving ANY kind of card. All strangenesses are handled in NC.CardDirtyP and
NC.MarkCardDirty. Added print statements to show what is being saved. Lets NC.CardDirtyP take care of proper dirty
checks.)
(* * rht 2/8/85: Added InsureFilingFlg)
(* * rht 6/25/85: Pulled out InsureFilingFlg. That check now done upstairs in NC.QuitCard.)
(* * rht 9/20/85: Added QuietFlg.)
(* * fgh 11/12/85 Updated to handle Card objects. Removed DatabaseStream object.)
(* * kirk 29Jan86 replaced call on undefined NC.UpdateRegionData with NC.PutRegion)
(* * fgh 6/13/86 Added operations in progress code and DontCheckForOpsInProgressFlg arg.)
(* * fgh 6/26/86 Added InterestedWindow & OperationMsg arg.)
(* * rht 7/4/86: Added check for readonly notefile.)
(* * kef 7/22/86: Added something to obtain the write permission on the FROMLINKS if the links have been changed.
FROMLINKS aren't ordinarily obtained at edit time like the rest of the links are.)
(* * kef 7/30/86: Modified to check for Client's concept of whether he owns the write lock or not, thus deciding
whether or not to setup the release of the write lock afterwards.)
(* * kef 7/30/86: Added a check to see if the NewCardFlg was on, then release TITLE and FROMLINKS writelocks.
This is needed since ordinary deactivation of cards won't do this; i.e., only new cards have their TITLE and
FROMLINKS also writelocked.)
(* * fgh 8/30/86 Changed APPLY* to NC.ApplyFn where possible.)
(* * rht&pmi 11/21/86: Now calls WhenSavedFn for card type if any.)
(* * rg 3/4/87 rewritten for new NC.ProtectedCardOperation, removed DontCheckForOpsInProgressFlg)
(* * rht 3/23/87: Fixed weirdness with InterestedWindow/Window.)
(* * Rht 3/24/87: Now calls NC.CoerceToInterestedWindow)
(* * rht 3/30/87: No longer prints messages if nothing got written down.)
(* * rg 3/31/87 fiddled w/ InterestedWindow stuff)
(* * rg 5/20/87 added FORCEOUTPUT on stream after all writes done. WARNING! THIS IS A KLUDGE, AND WILL ONLY WORK
FOR OLD-FASHIONED LOCAL NOTEFILES. For remote notefiles, we really need to add another operation to the protocol.)
(* * pmi 12/10/87: Now saves card's region if it has changed through either a reshape or a move.)
(LET ((Card (NC.CoerceToCard WindowOrID))
Window OldRegion NewRegion DoneAPutP)
(NC.ProtectedCardOperation
Card "Save Card" InterestedWindow (LET ((WhenSavedFn (GETPROP (NC.FetchType Card)
(QUOTE WhenSavedFn))))
(AND WhenSavedFn (APPLY* WhenSavedFn Card)))
(SETQ Window (NC.FetchWindow Card))
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow Card)))
(if (NC.CheckForNotReadOnly Card InterestedWindow "Can't save cards in ")
then (COND
((OR (NC.CardDirtyP Card)
(NC.FetchNewCardFlg Card))
(OR QuietFlg (NC.PrintMsg InterestedWindow T (OR OperationMsg "")
(NC.FetchTitle Card)
": Saving ... "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "substance, "))
(NC.PutMainCardData Card T)
(SETQ DoneAPutP T)
(NC.MarkCardDirty Card (QUOTE RESET)))
((AND (NOT (NC.FetchBeingDeletedFlg Card))
Window
(OR (NOT (EQUAL (fetch (REGION WIDTH) of (SETQ OldRegion
(NC.FetchRegion
Card)))
(fetch (REGION WIDTH)
of (SETQ NewRegion (WINDOWPROP
Window
(QUOTE REGION))))))
(NOT (EQUAL (fetch (REGION HEIGHT) of OldRegion)
(fetch (REGION HEIGHT) of NewRegion)))
(NOT (EQUAL (fetch (REGION LEFT) of OldRegion)
(fetch (REGION LEFT) of NewRegion)))
(NOT (EQUAL (fetch (REGION BOTTOM) of OldRegion)
(fetch (REGION BOTTOM) of NewRegion)))))
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow T
(OR OperationMsg "")
(NC.FetchTitle Card)
": Saving ... "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "region, "))
(NC.PutRegion Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchTitleDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow T
(OR OperationMsg "")
(NC.FetchTitle Card)
": Saving ... "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "title, "))
(NC.PutTitle Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchPropListDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow T
(OR OperationMsg "")
(NC.FetchTitle Card)
": Saving ... "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "proplist, "))
(NC.PutPropList Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchLinksDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow T
(OR OperationMsg "")
(NC.FetchTitle Card)
": Saving ... "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "links, "))
(* Make sure that we have the FROMLINKS of this card.
Only necessary because all of the LINKS are written
together.)
(RESETLST (until (NC.ApplyFn ObtainWritePermissionFn Card (QUOTE
FROMLINKS))
do (BLOCK)
(NC.PrintMsg InterestedWindow NIL
"waiting for FROMLINKS write permission...."))
(RESETSAVE NIL (BQUOTE (APPLY* , (fetch (Card
ReleaseWritePermissionFn)
of Card)
, Card FROMLINKS)))
(NC.PutLinks Card)
(SETQ DoneAPutP T))))
(* It's not a new card anymore.)
(FORCEOUTPUT (fetch (NoteFile Stream) of (fetch (Card NoteFile)
of Card))
T)
(COND
((NC.FetchNewCardFlg Card)
(* If a new card, then make sure we release the FROMLINKS and TITLE. Necessary because DeactivateCard normally
doesn't do this, because the FROMLINKS and TITLE aren't ordinarily owned on an active card.)
(NC.ApplyFn ReleaseWritePermissionFn Card (QUOTE FROMLINKS))
(NC.ApplyFn ReleaseWritePermissionFn Card (QUOTE TITLE))
(NC.SetNewCardFlg Card NIL)))
(OR QuietFlg (if DoneAPutP
then (NC.PrintMsg InterestedWindow NIL "Done."
(CHARACTER 13))
(NC.ClearMsg InterestedWindow T))))))))
(NC.SeverExternalLinks
(LAMBDA (ListOfCards QuietFlg InterestedWindow) (* pmi: "10-Dec-87 18:12")
(* * Delete all links in ListOfCards to or from cards not in ListOfCards. Furthermore, do it efficiently by caching
an external card only long enough to delete all the links between it and ListOfCards. Note that we depend on the
fact that every card in ListOfCards has its AboutToBeDeletedFlg set.)
(* * rht&pmi 5/29/87: Now passes non-nil LeaveCachedFlg to NC.RetrieveToLinks and NC.RetrieveFromLinks.
Not sure if this is really necessary.)
(* * pmi 6/8/87: Added call to NC.GreyCard to grey cards being deleted before deleting all of their links.)
(* * dsj. 10/12/87. Changed to do lazy updating of links and only half-sever links for which this card is the
destination: let the other half be severed and updated when and if the source card is invoked.)
(* * rht 10/31/87: Now uncaches links after call to NC.PutLinks on "external" source cards.)
(* * pmi 12/10/87: Merged dsj's and rht's changes; see last two comments above.)
(LET (LinksToSever NumLinksToSever)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Gathering external links of "
(LENGTH ListOfCards)
" cards."))
(SETQ LinksToSever (NC.UnionListsOfLinks
(for Card in ListOfCards
join (* Grey the cards being deleted.)
(NC.GreyCard Card)
(for Link in (NC.RetrieveToLinks Card T)
unless (NC.UIDGetProp (fetch (Card UID) of (fetch (Link
DestinationCard)
of Link))
(QUOTE AboutToBeDeletedFlg))
collect Link))
(for Card in ListOfCards join (for Link in (NC.RetrieveFromLinks Card T)
unless (NC.UIDGetProp
(fetch (Card UID)
of (fetch (Link SourceCard)
of Link))
(QUOTE AboutToBeDeletedFlg))
collect Link))))
(* * Now sort links so that links with same external anchor card are grouped together. Furthermore, the links
having that anchor card has source card are grouped before the ones having that card as destination card.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Sorting " (SETQ NumLinksToSever
(LENGTH LinksToSever))
" links prior to severing."))
(SORT LinksToSever (FUNCTION (LAMBDA (Link1 Link2)
(LET (DestCard1 DestCard2 ExtCard1 ExtCard2 Link1SourceIsExtFlg)
(SETQ ExtCard1 (if (NC.UIDGetProp (fetch (Card UID)
of (SETQ DestCard1
(fetch (Link
DestinationCard)
of Link1)))
(QUOTE AboutToBeDeletedFlg))
then (SETQ Link1SourceIsExtFlg T)
(fetch (Link SourceCard) of Link1)
else DestCard1))
(SETQ ExtCard2 (if (NC.UIDGetProp (fetch (Card UID)
of (SETQ DestCard2
(fetch (Link
DestinationCard)
of Link2)))
(QUOTE AboutToBeDeletedFlg))
then (fetch (Link SourceCard) of Link2)
else DestCard2))
(if (NC.SameCardP ExtCard1 ExtCard2)
then Link1SourceIsExtFlg
else (LESSP (fetch (Card IndexLoc) of ExtCard1)
(fetch (Card IndexLoc) of ExtCard2)))))))
(* * Now walk down the list of links one by one activating the external anchor cards as needed.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Severing links: 1 out of " NumLinksToSever
" ..."))
(* * dsj. Changed to only half-sever links for which this card is the destination: let the other half be severed
and updated when and if the source card is invoked.)
(for Link in LinksToSever as i from 1 bind PreviousExtCard WasNotActiveFlg
PreviousExtCardIsSourceFlg
eachtime (BLOCK) when (NC.ValidLinkP Link)
do (OR QuietFlg (if (ZEROP (REMAINDER i 10))
then (NC.PrintMsg InterestedWindow T "Severing links: " i
" out of "
NumLinksToSever " ...")))
(LET (ExtCard ExtCardIsSourceFlg)
(SETQ ExtCard (if (NC.UIDGetProp (fetch (Card UID)
of (fetch (Link DestinationCard)
of Link))
(QUOTE AboutToBeDeletedFlg))
then (SETQ ExtCardIsSourceFlg T)
(fetch (Link SourceCard) of Link)
else (fetch (Link DestinationCard) of Link)))
(if (NOT (NC.SameCardP ExtCard PreviousExtCard))
then (* Write down changes to previous external card's
substance.)
(if WasNotActiveFlg
then (if PreviousExtCardIsSourceFlg
then (* Have to call NC.CardSaveFn first and then
NC.QuitCard with Don'tSaveFlg to avoid
insureProperFiling check.)
(* dsj. Disabled this.)
(* (NC.CardSaveFn PreviousExtCard T)
(NC.QuitCard PreviousExtCard NIL T NIL NIL NIL T))
else (NC.PutLinks PreviousExtCard)
(NC.UncacheLinks PreviousExtCard)))
(* If ExtCard not active, then cache.)
(if (SETQ WasNotActiveFlg (NOT (NC.ActiveCardP ExtCard)))
then (if ExtCardIsSourceFlg
then (* Cache whole card if it's the link's source.)
(* dsj. Disabled this.)
(* (NC.GetNoteCard ExtCard))
else (* Else only need the links since we're deleting the
from link.)
(NC.GetLinks ExtCard))))
(* Delete the appropriate half of the link.)
(if ExtCardIsSourceFlg
then (* dsj. Now delete TO link only if the card is active
on the screen.)
(AND (NOT WasNotActiveFlg)
(NC.DeleteToLink Link))
else (NC.DeleteFromLink Link))
(replace (Link UID) of Link with -1)
(SETQ PreviousExtCard ExtCard)
(SETQ PreviousExtCardIsSourceFlg ExtCardIsSourceFlg))
finally (if (AND WasNotActiveFlg (NC.ValidCardP PreviousExtCard))
then (if PreviousExtCardIsSourceFlg
then (* Have to call NC.CardSaveFn first and then
NC.QuitCard with Don'tSaveFlg to avoid
insureProperFiling check.)
(* dsj. Disabled this.)
(* (NC.CardSaveFn PreviousExtCard T)
(NC.QuitCard PreviousExtCard NIL T NIL NIL NIL T))
else (NC.PutLinks PreviousExtCard)
(NC.UncacheLinks PreviousExtCard)))))))
(NC.RetrieveLinkLabels
(LAMBDA (NoteFile SystemLinksFlg) (* pmi: " 6-Jan-88 14:55")
(* Retrieve the list of link labels used in database
specified by DatabaseStream.
Include system maintained links only when specified by
SystemLinksFlg)
(* * fgh 11/12/85 Updated to handle NoteFile and Card objects.)
(* * pmi 1/6/88: Added check for LinkLabelsCard being cached before getting it from the notefile.)
(DECLARE (GLOBALVARS NC.SystemLinkLabels))
(LET ((LinkLabelsCard (fetch (NoteFile LinkLabelsCard) of NoteFile)))
(UNION (AND SystemLinksFlg NC.SystemLinkLabels)
(for Label in (OR (NC.FetchSubstance LinkLabelsCard)
(NCP.CardCachedP LinkLabelsCard)
(PROGN (NC.GetNoteCard LinkLabelsCard)
(NC.FetchSubstance LinkLabelsCard)))
when (OR SystemLinksFlg (NULL (NC.SystemLinkLabelP Label)))
collect Label)))))
(NC.DeleteNoteCard
(LAMBDA (CardIdentifier DontClearFlg NoConfirmFlg QuietFlg InterestedWindow)
(* pmi: "15-Jan-88 11:49")
(* * User interface level fn to delete a single note card from a NoteFile)
(* * rht 3/25/87: Added a bunch of new args. Fixed InterestedWindow stuff.)
(* * 3/26/87: Now clears InterestedWindow when done.)
(* * pmi 3/27/87: Changed call of NC.SeverAllLinks to NC.SeverExternalLinks.)
(* * 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))
(LET ((Card (NC.CoerceToCard CardIdentifier)))
(if (NC.ValidCardP Card)
then (OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow
Card)))
(NC.ProtectedCardOperation Card "Delete Note Card" InterestedWindow
(AND (if (NC.TopLevelCardP Card)
then (NC.PrintMsg InterestedWindow T
"You cannot delete this FileBox."
(CHARACTER 13))
(DISMISS 1000)
(NC.ClearMsg InterestedWindow T)
NIL
else T)
(NC.CheckForNotReadOnly Card InterestedWindow
"Can't delete cards from a ")
(OR NoConfirmFlg
(PROG1 (NC.AskYesOrNo
"Are you sure you want to delete this?"
" -- " "Yes"
(NULL
DontClearFlg)
InterestedWindow NIL
NIL)
(NC.ClearMsg InterestedWindow
T)))
(if (NC.CardsToDelete Card)
then T
else (NC.PrintMsg InterestedWindow T
"This card cannot be deleted."
(CHARACTER 13))
(DISMISS 1000)
(NC.ClearMsg InterestedWindow T)
NIL)
(PROGN
(* * Mark UID of card about to be deleted.)
(NC.UIDPutProp (fetch
(Card UID)
of Card)
(QUOTE
AboutToBeDeletedFlg)
T)
(* * Sever all links into and out of Card)
(NC.SeverExternalLinks (LIST
Card)
QuietFlg
InterestedWindow)
(* * Now delete the card)
(PROG1 (NC.DeleteNoteCardInternal
Card QuietFlg
InterestedWindow)
(OR QuietFlg
(NC.ClearMsg
InterestedWindow T)))
)))))))
(NC.DeleteNoteCards
(LAMBDA (CardIdentifiers NoIndividualConfirmFlg DontClearFlg InterestedWindow QuietFlg
NoGroupConfirmFlg) (* pmi: "15-Jan-88 11:46")
(* 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))
(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)
(NC.ClearMsg))))
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)
(NC.ClearMsg))))
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)
(QUOTE
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))))))
)
(* * Changed in NCTEXTCARD)
(DEFINEQ
(NC.MakeTEditCard
(LAMBDA (Card Title NoDisplayFlg ParamList) (* pmi: "10-Dec-87 11:47")
(* Make up a blank text card and display it.)
(* * rht 9/10/85: Fixed call to NC.MakeTEditPropsList so prompt window gets fixed up before card is brought up.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * rht 4/11/86: Now passes type to NC.MakeTEditMiddleMenu.)
(* * rht 5/6/86: Now calls NC.InstallTitleBarLeftMenu and NC.InstallTextTitleBarMiddleMenu.)
(* * rht 9/8/86: No longer hangs Card off NoteCardObject windowprop. THis is done in NC.MakeNoteCard.)
(* * rht 9/19/86: Mod to above fix. Now calls NC.MakeNewCardWindow a new fn that creates window and hangs Card off
windowprop. Also takes ParamList arg.)
(* * rht&pmi 11/19/86: Now passes NoteFile arg to NC.MakeTEditPropsList.)
(* * rht 4/17/87: Now makes a prompt window before opening the window.)
(* * dsj 9/22/87: Added call to NC.SetTitle so title passing from calling fns works properly.)
(* * pmi 12/10/87: Added dsj's changes; see above comments.)
(LET (TextStream Window Type)
(COND
(NoDisplayFlg (SETQ TextStream (OPENTEXTSTREAM "" NIL NIL NIL
(NC.MakeTEditPropsList
NIL
(LISTGET ParamList (QUOTE
Don'tAttachUserSpecifiedPropsFlg)))))
(NC.SetSubstance Card TextStream)
(STREAMPROP TextStream (QUOTE NoteCardObject)
Card)
Card)
(T (SETQ Window (NC.MakeNewCardWindow Card (OR Title "Untitled")
NIL T))
(* Make a prompt window "invisibly" so it gets hooked
in.)
(NC.AttachPromptWindowOffScreen Window)
(NC.SetTitle Card Title)
(SETQ Type (NC.RetrieveType Card))
(NC.InstallTitleBarLeftMenu Window Type)
(NC.InstallTextTitleBarMiddleMenu Window Type)
(WINDOWADDPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.TextCardShrinkFn))
(TEDIT NIL Window NIL (NC.MakeTEditPropsList Window (NC.FileBoxP Card T)
(fetch (Card NoteFile) of Card)))
(until (WINDOWPROP Window (QUOTE TEXTSTREAM)) do (BLOCK))
(SETQ TextStream (WINDOWPROP Window (QUOTE TEXTSTREAM)))
(NC.SetSubstance Card TextStream)
(STREAMPROP TextStream (QUOTE NoteCardObject)
Card)
Window)))))
)
(* * Changed in NCTYPESMECH)
(DEFINEQ
(NC.DeleteCardType
(LAMBDA (TypeName DeleteSubTypesFlg) (* pmi: "10-Dec-87 11:23")
(* * Deletes a card type. If DeleteSubTypesFlg is non-NIL recursively deletes all sub-types.
If DeleteSubTypesFlg is NIL, then attempting to delete a type with sub-types is an error.)
(* * fgh 1/31/86 First created.)
(* * rg 3/27/87 added WITH.MONITOR)
(* * dsj 9/27/87: now clears NC.NoteCardTypeMenu so that the type no longer appears on the menu of card types.)
(* * pmi 12/10/87: Added dsj's change; see above comment.)
(DECLARE (GLOBALVARS NC.NoteCardTypeMenu))
(WITH.MONITOR NC.TypesLock (LET ((SubTypes (NC.SubTypesOfCardType TypeName)))
(if SubTypes
then (if DeleteSubTypesFlg
then (for SubType in SubTypes
do (NC.DeleteCardType SubType
DeleteSubTypesFlg))
else (NC.ReportError NIL (CONCAT
"Cannot delete a card type with existing sub-types."
(CHARACTER
13)
"This type has sub-types: "
SubTypes))))
(PUTHASH TypeName NIL NC.CardTypes)
(SETQ NC.NoteCardTypeMenu)))))
)
(* * Changed in NCBROWSERCARD)
(DEFINEQ
(NC.GetBrowserNodeID
(LAMBDA (BrowserCard NodeCard) (* DSJ: "11-Nov-87 20:55")
(* * Create a browser node atom from a new UID. Hang the card object off as a property for those who need it.)
(* * rht 11/18/85: Now checks to see if NodeCard already appears in graph before creating a new GraphNodeID.
Use the browser hash array to do the lookup.)
(* * rht 6/1/87: Changed hash array to map from card UIDs to graph node ids rather than from card objects to graph
node ids.)
(* * dsj. 11/12/87. Changed so won't break if NodeCard if NIL. It may be in certain 1.2 --> 1.3 conversion cases.)
(LET ((HashArray (NC.HashArrayFromBrowserCard BrowserCard))
(NodeCardUID (AND NodeCard (fetch (Card UID) of NodeCard)))
NewUID)
(if (GETHASH NodeCardUID HashArray)
else (NC.GraphNodeIDPutProp (SETQ NewUID (NC.MakeBrowserNodeUID))
(QUOTE CardObject)
NodeCard)
(PUTHASH NodeCardUID NewUID HashArray)
NewUID))))
)
(PUTPROPS PMIPATCH075 COPYRIGHT ("Xerox Corporation" 1987 1988))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2853 11847 (NCP.AddNoteFileIconMiddleButtonItems 2863 . 4040) (NCP.DisplayedCards 4042
. 5396) (NCP.CreateCard 5398 . 7721) (NCP.ValidCardP 7723 . 8178) (NCP.ListRegisteredCards 8180 .
9600) (NCP.OpenNoteFile 9602 . 11052) (NCP.CreateLinkType 11054 . 11845)) (11877 19617 (
NCP.AddDefaultNoteFileIconMiddleButtonItems 11887 . 12662) (NCP.NoticedNoteFileNamesMenu 12664 . 13485
) (NCP.AddTitleBarMenuItemsToType 13487 . 15350) (NCP.AddTitleBarMenuItemsToWindow 15352 . 17102) (
NCP.LinkIconAttachedBitMap 17104 . 17881) (NCP.SessionIconWindow 17883 . 18200) (
NCP.BringUpSessionIcon 18202 . 18516) (NCP.SystemLinkTypeP 18518 . 18822) (NCP.CardBeingDeletedP 18824
. 19095) (NCP.NoteFileClosingP 19097 . 19615)) (19706 74370 (NC.NoticedNoteFileNamesMenu 19716 .
27237) (NC.RunCloseEvents 27239 . 29196) (NC.CopyCards 29198 . 41982) (NC.AbortSession 41984 . 48761)
(NC.OpenNoteFile 48763 . 67043) (NC.ProcessNoteFileNotFoundError 67045 . 69514) (NC.NoteFileNoticedP
69516 . 70456) (NC.NoticeNoteFileName 70458 . 73055) (NC.RemoveNoteFileName 73057 . 74368)) (74406
89752 (NC.BringUpNoteCardsIcon 74416 . 75442) (NC.AskNoteCardType 75444 . 77786) (
NC.SetUpNoteFileInterface 77788 . 85657) (NC.ListOfNoteFilesMenu 85659 . 89750)) (90023 91548 (
NC.EvaluateListCardSubstance 90033 . 91546)) (91576 92305 (NC.CardsToDelete 91586 . 92303)) (92337
123313 (NC.EditNoteCard 92347 . 96716) (NC.CardSaveFn 96718 . 104104) (NC.SeverExternalLinks 104106 .
111766) (NC.RetrieveLinkLabels 111768 . 112886) (NC.DeleteNoteCard 112888 . 115838) (
NC.DeleteNoteCards 115840 . 123311)) (123348 126070 (NC.MakeTEditCard 123358 . 126068)) (126106 127414
(NC.DeleteCardType 126116 . 127412)) (127452 128574 (NC.GetBrowserNodeID 127462 . 128572)))))
STOP