(FILECREATED " 1-Sep-86 19:38:06" {QV}<NOTECARDS>1.3K>SERVER>NCDEVICEPATCH.;16 152971
changes to: (VARS NCDEVICEPATCHCOMS)
(FNS NC.CompactNoteFile NC.InspectAndRepairNoteFile NC.HookToOrphanCard
NC.NoteFileOperations NC.InsertLinkBeforeMarker NC.InsertLinkInOrdering
NC.OpenDatabaseFile NC.ReadOnlyNoteFileP NC.CloseNoteFile
NC.CheckpointDatabase NC.CloseDatabaseFile NC.MakeNoteCard
NC.DatabaseFileName NC.GetMainCardData NC.GetType NC.GetTitle NC.GetLinks
NC.GetPropList NC.PutMainCardData NC.PutRegion NC.PutTitle NC.PutLinks
NC.PutPropList NC.GetNewCard NC.DelReferencesToCard NC.AssignTitle
NC.ChangeLinkDisplayMode NC.RelabelLink NC.ChangeCardTitleFromLinkIcon
NC.DeleteLink NC.MakeLink NC.ClosePropListEditor NC.EditProperties
NC.CardSaveFn NC.DeleteNoteCard NC.QuitWithoutSaving NC.DeactivateCard
NC.EditNoteCard)
(RECORDS NoteFile Card)
(MACROS NC.DoCardPartFn NC.IfMultipleCardPartsNotBusy NC.IfCardPartNotBusy
NC.WithWritePermission)
previous date: "30-Aug-86 01:24:16" {QV}<NOTECARDS>1.3K>SERVER>NCDEVICEPATCH.;3)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCDEVICEPATCHCOMS)
(RPAQQ NCDEVICEPATCHCOMS ((* Changed functions from NCDATABASE)
(FNS NC.DatabaseFileName NC.DeleteDatabaseFile NC.OpenDatabaseFile NC.CloseDatabaseFile
NC.CheckpointDatabase NC.NoteFileOpenP NC.GetMainCardData NC.GetType NC.GetTitle
NC.GetLinks NC.GetPropList NC.PutMainCardData NC.PutRegion NC.PutTitle NC.PutLinks
NC.PutPropList NC.GetNewCard NC.ReadOnlyNoteFileP)
(RECORDS NoteFile)
(* Changed functions from NCCARDS)
(FNS NC.QuitWithoutSaving NC.DeactivateCard NC.MakeNoteCard NC.AssignTitle NC.EditNoteCard
NC.ClosePropListEditor NC.EditProperties NC.CardSaveFn NC.DeleteNoteCard)
(RECORDS Card)
(* Changed functions from NCINTERFACE)
(FNS NC.CloseNoteFile NC.NoteFileOperations NC.FileBrowserMenu)
(* Changed functions from NCLINKS)
(FNS NC.ChangeLinkDisplayMode NC.RelabelLink NC.ChangeCardTitleFromLinkIcon NC.DeleteLink
NC.MakeLink NC.AddFromLink NC.InsertLinkBeforeMarker NC.InsertLinkInOrdering
NC.HookToOrphanCard NC.DelFromLink NC.DelReferencesToCard)
(* Changed functions from NCCOMPACT)
(FNS NC.CompactNoteFile)
(* Changed functions from NCREPAIR)
(FNS NC.InspectAndRepairNoteFile)
(* * New for NCCARDS)
(MACROS NC.WithWritePermission NC.IfCardPartNotBusy NC.IfMultipleCardPartsNotBusy
NC.DoCardPartFn)
(FILES FILEBROWSERPATCH)
(* Miscellaneous patches)
(ADVISE FULLNAME)
(FNS NCDEVICE.FULLNAME)))
(* Changed functions from NCDATABASE)
(DEFINEQ
(NC.DatabaseFileName
(LAMBDA (Msg Prompt ClearFirstFlg NoSuggestFlg Name InterestedWindow)
(* fgh: "31-Aug-86 22:28")
(* Make a NoteCards database file name on the base
specified by the user. Basically, add the NOTEFILE
extension)
(* * rht 8/7/84: Now provides file name suggestion for user (unless NoSuggestFlg is non-nil.) The suggestion is in
the global var NC.DatabaseFileNameSuggestion which is reset to the new file name before returning.)
(* * kirk 23Jan86 Added optional InterestedWindow)
(* * rht 7/2/86: Fixed to just pass InterestedWindow to NC.AskUser rather than computing the prompt window of
that.)
(* * kef 7/21/86: Removed the call to FULLNAME, which was causing problems if the file happened to be located on a
NoteCards server that did not also support FileService.)
(* * fgh 8/31/86 Restored FULLNAME for Non-remote hosts.)
(DECLARE (GLOBALVARS NC.DatabaseFileNameSuggestion))
(OR Name (SETQ Name (MKATOM (NC.AskUser Msg Prompt (AND (NOT NoSuggestFlg)
NC.DatabaseFileNameSuggestion)
ClearFirstFlg InterestedWindow))))
(if Name
then (SETQ Name (PACKFILENAME (QUOTE BODY)
Name
(QUOTE EXTENSION)
(QUOTE NOTEFILE)))
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
(if (NC.RemoteHostP Name)
then Name
else (FULLNAME Name))))
Name
else NIL)))
(NC.DeleteDatabaseFile
[LAMBDA (FileNameOrNoteFile InterestedWindow Don'tConfirmFlg QuietFlg)
(* Feuerman " 8-Aug-86 14:16")
(* Delete file FileName)
(* * rht 8/7/84: If delete happens, clear NC.DatabaseFileNameSuggestion.)
(* * rht 3/17/85: Fixed for case when user specifies version number of file to delete.)
(* * fkr 11/8/85: Ripped out PSA.Database check. Added check for file open.)
(* * kirk 23Jan86 Changed to use NC.AskYesOrNo)
(* * fgh 6/24/86 Added ability to pass down NoteFile object as well as file name. Added code to remove NF from NFs
hash array and remove the menu on the screen.)
(* * rht 7/2/86: No longer prints completed message with DISMISS. Now returns non-nil if successful.
Accepts Don'tConfirmFlg arg.)
(* * fgh 7/5/86 Added call to RemoveAccessToNoteFile.)
(* * rht 7/13/86: Added QuietFlg arg.)
(* * kef 8/8/86: Factored out into device specific vectors.)
(PROG ((FileName (if (type? NoteFile FileNameOrNoteFile)
then (fetch (NoteFile FullFileName) of FileNameOrNoteFile)
else FileNameOrNoteFile))
FullFileName) (* Make sure no open databases)
(* Get file name)
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName "Name of Notefile to be deleted:"
" -- "
T NIL NIL InterestedWindow)))
(RETURN NIL)) (* make sure to be deleted file exists)
(SETQ FullFileName (if (EQ (FILENAMEFIELD FileName (QUOTE HOST))
(QUOTE DSK))
then (if (FILENAMEFIELD FileName (QUOTE VERSION))
then (FULLNAME FileName)
else (CAR (FILDIR-EARLIEST FileName)))
else FileName))
(COND
((NULL FullFileName)
(NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T FileName " does not exist." (CHARACTER 13)
"Delete cancelled."
(CHARACTER 13))
(RETURN)))
(* * Can't delete an open file.)
(* Ask user to confirm twice.)
[OR Don'tConfirmFlg (COND
((NOT (NC.AskYesOrNo (CONCAT "Are you sure you want to delete "
(CHARACTER 13)
FullFileName "?" (CHARACTER 13))
" -- " "No" T (NC.AttachPromptWindow InterestedWindow)
(NOT InterestedWindow)))
(OR QuietFlg (NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T FullFileName " not deleted." (CHARACTER
13)))
(RETURN]
(OR QuietFlg (NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T "Deleting" FullFileName (CHARACTER 13)))
(DISMISS 1000)
[OR Don'tConfirmFlg (COND
((NOT (NC.AskYesOrNo (CONCAT "Are you still sure you want to delete "
(CHARACTER 13)
FullFileName "?" (CHARACTER 13))
" -- " "No" T (NC.AttachPromptWindow InterestedWindow)
(NOT InterestedWindow)))
(OR QuietFlg (NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T FullFileName " not deleted." (CHARACTER
13)))
(RETURN]
(* * Delete the file)
(SETQ FullFileName (APPLY* (fetch (NoteFileDevice DeleteNoteFileFn)
of (GETHASH (COND
((NC.RemoteHostP FullFileName)
(QUOTE REMOTEMULTIUSER))
(T (QUOTE LOCALSINGLEUSER)))
NC.DeviceVectorsHashArray))
FullFileName))
(if (NULL FullFileName)
then (RETURN))
(NC.RemoveAccessToNoteFile FullFileName)
(SETQ NC.DatabaseFileNameSuggestion NIL)
(NC.ClearMsg InterestedWindow T)
(RETURN FullFileName])
(NC.OpenDatabaseFile
(LAMBDA (NoteFileOrFileName Access Don'tCacheTypesAndTitlesFlg QuietFlg Don'tCreateFlg
Convertw/oConfirmFlg Don'tCreateArrayFlg Don'tTruncateFlg
Don'tCreateInterfaceFlg Don'tGetSpecialCardsFlg InterestedWindow)
(* fgh: " 1-Sep-86 13:55")
(DECLARE (GLOBALVARS NC.NoteFilesHashArray))
(NC.OpenNoteFile NoteFileOrFileName NC.NoteFilesHashArray Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg Convertw/oConfirmFlg Don'tCreateArrayFlg Don'tTruncateFlg
Don'tCreateInterfaceFlg Don'tGetSpecialCardsFlg InterestedWindow NIL NIL NIL
QuietFlg (if (EQ Access (QUOTE INPUT))
then T
else NIL))))
(NC.CloseDatabaseFile
(LAMBDA (NoteFile) (* fgh: " 1-Sep-86 00:51")
(NC.CloseNoteFile NoteFile)))
(NC.CheckpointDatabase
(LAMBDA (NoteFile QuietFlg Don'tSaveDirtyCardsFlg Don'tCheckOperationInProgressFlg
Don'tCheckCardOperationsInProgressFlg InterestedWindow OperationMsg)
(* fgh: " 1-Sep-86 13:58")
(* * First save to the database any cards currently dirty. Copy the index array back into the file and set the
LastChkptPtr to the end of the file.)
(* * rht 11/12/85: Now calls NC.PutHashArray to do the hard work.)
(* * fgh 6/4/86 Added Don'tSaveDirtyCardsFlg to prevent double passes through active cards at close time)
(* * fgh 6/13/86 Changed printouts to NF menu. Added check for operations in progress.)
(* * fgh 6/25/86 Put in contention lock and NC.ProtectedNoteFileOperation Added Don'tCheckOperationInProgressFlg
Don'tCheckCardOperationsInProgressFlg & InterestedWindow args.)
(* * rht 7/4/86: Added check for readonly notefile.)
(* * rht 7/16/86: Now passes QuietFlg arg down to NC.SaveDirtyCards.)
(* * fgh 9/1/86 Now just a compatibility wrapper for NC.CheckpointNoteFile. Part of device vector impleementation.)
(NC.CheckpointNoteFile NoteFile QuietFlg Don'tSaveDirtyCardsFlg
Don'tCheckOperationInProgressFlg Don'tCheckCardOperationsInProgressFlg
InterestedWindow OperationMsg)))
(NC.NoteFileOpenP
[LAMBDA (NoteFile) (* Feuerman "21-Jul-86 10:36")
(* * Is NoteFile an open NoteFile)
(* * kef 7/21/86: Now just calls the device vector function.)
(APPLY* (fetch (NoteFile NoteFileOpenPFn) of NoteFile)
NoteFile])
(NC.GetMainCardData
(LAMBDA (Card) (* fgh: "31-Aug-86 22:50")
(* Get a note card from the database. If IncludeDeletedCardsFlg is NIL, then return immediately if card is deleted
or free. Otherwise, get dekleted but not free cards.)
(* * rht 1/31/85: Now reads pointers from index array rather than file.)
(* * rht 7/9/85: Now gets date if notefile has newer data format.)
(* * rht 11/10/85 Updated to handle new Card scheme and NoteFile objects.)
(* * fgh 11/20/85 Added call to NC.ReadCardPartHeader and put in code to read Start and End pointers before calling
card type's getfn.)
(* * kirk 27Nov85 abstracted this function out of NC.GetNoteCard)
(* * rht 1/23/86: Now takes optional OverrideStream arg. This, if given, overrides stream of card's notefile.)
(* * rht 1/28/86: Now passes extra arg to NC.ReadCardPartHeader indicating that when we're overriding the notefile
stream, you shouldn't force UIDs on stream and in card to match.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * fgh 2/6/86 Added support for version numbers on the substance get fn.)
(* * kirk 14Feb86 Merged the above 4 changes)
(* * kef 7/16/86: Uses the device vector GetCardPartFn to set up the stream and stream pointer for reading.)
(* * kef 8/1/86: Moved the check for ACTIVE status to beginning.)
(* * fgh 8/31/86 Adpated to use NC.DoCardPartFn.)
(DECLARE (GLOBALVARS NC.ItemIdentifier))
(if (EQ (fetch (Card Status) of Card)
(QUOTE ACTIVE))
then (WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(NC.DoCardPartFn Get Card (QUOTE SUBSTANCE)
(LET ((Stream (NC.CoerceToNoteFileStream Card))
Length SubstanceVersion)
(* * Read the header info)
(NC.SetItemDate Card (NC.ReadCardPartHeader
Card NC.ItemIdentifier Stream))
(* * read card type and region)
(NC.SetType Card (NC.ReadCardType Stream))
(NC.SetRegion Card (NC.ReadRegion Stream))
(* * Read the length of substance, then call the substance get fn)
(SETQ Length (NC.ReadPtr Stream 3))
(SETQ SubstanceVersion (NC.GetPtr Stream 1))
(NC.SetSubstance Card
(NC.ApplyFn GetFn Card Length
Stream
SubstanceVersion))
Card))))))
(NC.GetType
(LAMBDA (Card) (* fgh: "31-Aug-86 22:40")
(* Retrieve the NoteCardType of card specified by
NoteCardID from the database specified by
DatabaseStream)
(* * rht 1/31/85: Now reads pointers from index array rather than file.)
(* * rht 7/9/85: Now gets date if notefile has newer data format.)
(* * kirk 10/18/85; Now returns NIL if status not ACTIVE)
(* * fkr 10/29/85: Fixed to use new numeric ID format. Also added NC.SetTitle call.)
(* * rht 11/10/85 Updated to handle new Card scheme and NoteFile objects.)
(* * fgh 11/20/85 Added call to NC.ReadCardPartHeader)
(* * rht 1/23/86: Now takes optional OverrideStream arg. This, if given, overrides stream of card's notefile.)
(* * rht 1/28/86: Now passes extra arg to NC.ReadCardPartHeader indicating that when we're overriding the notefile
stream, you shouldn't force UIDs on stream and in card to match.)
(* * kef 7/16/86: Uses the device vector GetCardPartFn to set up the stream and stream pointer for reading.)
(* * kef 7/30/86: Changed to use GetCardInfoFn of the device vector.)
(* * kef 8/1/86: Decided there are some cases, such as new cards, where we may want the Type of the card even
though it isn't ACTIVE yet.)
(* * fgh 8/31/86 Changed APPLY* to NC.ApplyFn.)
(WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(AND (OR (NULL (NC.FetchStatus Card))
(EQ (NC.FetchStatus Card)
(QUOTE ACTIVE)))
(LET (CardType)
(NC.SetType Card (SETQ CardType (CDR (FASSOC
(QUOTE TYPE)
(NC.ApplyFn GetCardInfoFn
Card
(QUOTE
TYPE))))))
CardType)))))
(NC.GetTitle
(LAMBDA (Card) (* fgh: "31-Aug-86 22:52")
(* Retrieve title for card specified by Card from the
database specified by DatabaseStream)
(* * rht 1/31/85: Now reads pointers from index array rather than file.)
(* * rht 7/9/85: Now gets date if notefile has newer data format.)
(* * kirk 10/28/85 Now returns NIL if Status not ACTIVE)
(* * fkr 10/29/85: Fixed to use new numeric ID format.)
(* * rht 11/10/85 Updated to handle new Card scheme and NoteFile objects.)
(* * fgh 11/20/85 Added call to NC.ReadCardPartHeader)
(* * rht 1/23/86: Now takes optional OverrideStream arg. This, if given, overrides stream of card's notefile.)
(* * rht 1/28/86: Now passes extra arg to NC.ReadCardPartHeader indicating that when we're overriding the notefile
stream, you shouldn't force UIDs on stream and in card to match.)
(* * kef 7/16/86: Uses the device vector GetCardPartFn to set the stream and stream pointer in preparation for the
read.)
(* * kef 7/24/86: Added check of NewCardFlg.)
(* * fgh 8/31/86 Adtaped to use NC.DoCardPartFn.)
(DECLARE (GLOBALVARS NC.TitlesIdentifier))
(COND
((fetch (Card NewCardFlg) of Card)
NIL)
((EQ (fetch (Card Status) of Card)
(QUOTE ACTIVE))
(WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(NC.DoCardPartFn Get Card (QUOTE TITLE)
(* * Now we've actually executed the BEFORE part of the GETFN, while in a RESETLST that will ensure execution of
the AFTER part upon exit. This means that right now the Stream slot of the NoteFile is a random access stream with
the file pointer set to the beginning of the card part.)
(LET ((Stream (NC.CoerceToNoteFileStream Card))
Title)
(NC.SetTitleDate Card (NC.ReadCardPartHeader Card
NC.TitlesIdentifier
Stream))
(NC.SetTitle Card (SETQ Title (NC.ReadTitle Stream))
)
Title)))))))
(NC.GetLinks
(LAMBDA (Card) (* fgh: "31-Aug-86 22:54")
(* * rht 1/31/85: Now reads pointers from index array.)
(* * rht 2/9/85: Now fixes display formats on links read in.)
(* * rht 7/9/85: Now gets date if notefile has newer data format.)
(* * fkr 11/8/85 Updated to handle new Card scheme and NoteFile objects.)
(* * fgh 11/20/85 Added call to NC.ReadCardPartHeader)
(* * rht 1/23/86: Now takes optional OverrideStream arg. This, if given, overrides stream of card's notefile.)
(* * rht 1/28/86: Now passes extra arg to NC.ReadCardPartHeader indicating that when we're overriding the notefile
stream, you shouldn't force UIDs on stream and in card to match.)
(* * kef 7/16/86: Uses the device vector GetCardPartFn to set up the stream and stream pointer for reading.)
(* * kef 8/1/86: Moved the check for ACTIVE status to beginning.)
(* * fgh 8/31/86 Adapted to use NC.DoCardPartFn.)
(DECLARE (GLOBALVARS NC.LinksIdentifier))
(COND
((EQ (fetch (Card Status) of Card)
(QUOTE ACTIVE))
(WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(NC.DoCardPartFn Get Card (QUOTE LINKS)
(LET ((Stream (NC.CoerceToNoteFileStream Card)))
(* * Read the header and set the date)
(NC.SetLinksDate Card (NC.ReadCardPartHeader Card
NC.LinksIdentifier
Stream))
(* * Read the links)
(NC.SetToLinks Card (NC.ReadListOfLinks Stream))
(NC.SetFromLinks Card (NC.ReadListOfLinks Stream))
(NC.SetGlobalLinks Card (NC.ReadListOfLinks Stream))
(NC.SetLinksDirtyFlg Card NIL)
Card)))))))
(NC.GetPropList
(LAMBDA (Card) (* fgh: "31-Aug-86 22:55")
(* Retrieve the prop list for card specified by ID
from the database specified by DatabaseStream)
(* * rht 1/31/85: Now reads pointers from index array rather than file.)
(* * rht 7/9/85: Now gets date if notefile has newer data format.)
(* * rht 11/10/85 Updated to handle new Card scheme and NoteFile objects.)
(* * fgh 11/20/85 Added call to NC.ReadCardPartHeader)
(* * rht 1/23/86: Now takes optional OverrideStream arg. This, if given, overrides stream of card's notefile.)
(* * rht 1/28/86: Now passes extra arg to NC.ReadCardPartHeader indicating that when we're overriding the notefile
stream, you shouldn't force UIDs on stream and in card to match.)
(* * kef 7/16/86: Uses the device vector GetCardPartFn to set up the stream and stream pointer for reading.)
(* * kef 8/1/86: Moved the check for ACTIVE status to beginning.)
(* * fgh 8/31/86 Adapted to use NC.DoCardPartFn.)
(DECLARE (GLOBALVARS NC.PropsIdentifier))
(if (EQ (fetch (Card Status) of Card)
(QUOTE ACTIVE))
then (WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(NC.DoCardPartFn Get Card (QUOTE PROPLIST)
(LET ((Stream (NC.CoerceToNoteFileStream Card))
Props)
(* * set the fileptr to the beginning of the data, read the header, then read the prop list)
(NC.SetPropListDate Card (NC.ReadCardPartHeader
Card NC.PropsIdentifier
Stream))
(NC.SetPropList Card (SETQ Props (
NC.ReadPropList Stream)))
Props))))))
(NC.PutMainCardData
(LAMBDA (Card UpdateUpdateListFlg UseOldDateFlg) (* fgh: "31-Aug-86 22:58")
(* * Write note card specified by ID to the database specified by Database stream)
(* * rht 7/9/85: Now puts out date after identifier. If UseOldDateFlg is non-nil, then use old date, otherwise use
current date.)
(* * rht 11/10/85: Updated to handle NoteFile and Card scheme.)
(* * fgh 11/20/85 Added call to NC.WriteCardPartHeader and the mechanism to write the start and end pointers of the
substance before calling the card type's putfn.)
(* * kirk 29Nov85 Renamed from NC.PutNoteCard)
(* * rht 1/23/86: Now takes optional OverrideStream arg. This, if given, overrides stream of card's notefile.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * fgh 2/6/86 Added support for version numbers on the substance put fn.)
(* * kirk 14Feb86 Merged above two changes)
(* * rht 2/14/86: Fixed so call to NC.WriteCardType takes Stream as arg.)
(* * rht 2/17/86: Fixed so calls to NC.WriteCardPartHeader and to NC.WriteRegion take Stream arg.)
(* * kef 7/16/86: Makes use of the NoteFile device vector PutCardPartFn.)
(* * kef 8/1/86: Added notification of status change.)
(* * fgh 8/31/86 Adapted to use NC.DoCardPartFn.)
(DECLARE (GLOBALVARS NC.ItemIdentifier))
(LET (PutSuccessfulLoc)
(WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(NC.DoCardPartFn Put Card (QUOTE SUBSTANCE)
(LET ((Stream (NC.CoerceToNoteFileStream Card))
StartDataLoc EndLoc CardType StartSubstanceLoc
SubstanceVersion)
(* * Record update date on update list if necessary.)
(AND UpdateUpdateListFlg (NC.UpdateUpdateList Card))
(* * First write out the card part header)
(SETQ StartDataLoc (GETFILEPTR Stream))
(NC.WriteCardPartHeader Card NC.ItemIdentifier
(COND
(UseOldDateFlg (
NC.FetchItemDate
Card))
(T (NC.SetItemDate
Card
(DATE))))
Stream)
(* * write out the type and region)
(NC.WriteCardType Stream (SETQ CardType
(NC.RetrieveType Card)))
(NC.WriteRegion Card Stream)
(* * Write out the dummy length pointer for and version byte the actual substance)
(SETQ StartSubstanceLoc (GETFILEPTR Stream))
(NC.WritePtr Stream 0 4)
(* * Write out the substance of the card.)
(SETQ SubstanceVersion (NC.ApplyFn PutFn Card Stream))
(* * Update the length pointer at beginning of substance Subtract four so that length is the length of the actual
substance and doesn't include the length pointer and version byte maintained here. Also updated the version number
returned by the put fn.)
(SETQ EndLoc (GETFILEPTR Stream))
(SETFILEPTR Stream StartSubstanceLoc)
(NC.WritePtr Stream (DIFFERENCE (DIFFERENCE EndLoc
StartSubstanceLoc)
4)
3)
(SETQ SubstanceVersion (OR SubstanceVersion 0))
(NC.WritePtr Stream SubstanceVersion 1)
(* * Update the length field at the beginning of the card info)
(SETFILEPTR Stream StartDataLoc)
(NC.WritePtr Stream (DIFFERENCE EndLoc StartDataLoc)
3)
(SETFILEPTR Stream EndLoc)
(* * Now update the Index to reflect the new data just written. Done last in case the substance putting bombed for
some reason.)
(replace (Card Status) of Card with (QUOTE
ACTIVE))
(SETQ PutSuccessfulLoc StartDataLoc)
Card))))))
(NC.PutRegion
(LAMBDA (Card) (* fgh: "31-Aug-86 23:03")
(* * rht 1/31/85: Now reads pointers from index array rather than file.)
(* * rht 11/12/85: Updated to handle new Notefile and cardID format.)
(* * fgh 11/20/85 Added call to NC.ReadCardPartHeader)
(* * rht 1/23/86: Changed to use NC.CoerceToNoteFileStream)
(* * kef 7/28/86: Changed to play by multi-user device vector rules.)
(* * fgh 8/31/86 Adpated to use NC.DoCardPartFn.)
(LET (PutSuccessfulLoc)
(WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(NC.DoCardPartFn Put Card (QUOTE REGION)
(* * Check to make sure this is an active note card.)
(AND (NEQ (fetch (Card Status) of Card)
(QUOTE ACTIVE))
(NC.ReportError "NC.PutRegion" (CONCAT
(NC.FetchTitle Card)
" is not an active note card.")))
(NC.WriteRegion Card (NC.CoerceToNoteFileStream Card))
(SETQ PutSuccessfulLoc T)
Card)))))
(NC.PutTitle
(LAMBDA (Card UseOldDateFlg) (* fgh: "31-Aug-86 23:01")
(* * Put the title of card ID onto DatabaseStream)
(* * rht 7/9/85: Now puts out date after identifier. If UseOldDateFlg is non-nil, then use old date, otherwise use
current date.)
(* * rht 11/10/85: Updated to handle NoteFile and CardID scheme.)
(* * fgh 11/20/85 Added call to NC.WriteCardPartHeader and the mechanism to write the start and end pointers of the
substance before calling the card type's putfn.)
(* * rht 1/23/86: Now takes optional OverrideStream arg. This, if given, overrides stream of card's notefile.)
(* * kef 7/16/86: Makes use of the NoteFile device vector PutCardPartFn.)
(* * fgh 8/31/86 Adpated to use NC.DoCardPartFn.)
(* Check to make sure this is an active note card.)
(DECLARE (GLOBALVARS NC.TitlesIdentifier))
(AND (NEQ (fetch (Card Status) of Card)
(QUOTE ACTIVE))
(NC.ReportError "NC.PutTitle" (CONCAT (NC.FetchTitle Card)
" is not an active note card.")))
(LET (PutSuccessfulLoc)
(WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(NC.DoCardPartFn Put Card (QUOTE TITLE)
(LET ((Stream (NC.CoerceToNoteFileStream Card))
StartLoc EndLoc)
(* * First write out the title.)
(SETQ StartLoc (GETFILEPTR Stream))
(NC.WriteCardPartHeader Card NC.TitlesIdentifier
(COND
(UseOldDateFlg (
NC.FetchTitleDate
Card))
(T (NC.SetTitleDate
Card
(DATE))))
Stream)
(NC.WriteTitle Stream (NC.FetchTitle Card))
(* * Update the length field at the beginning of the card info)
(SETQ EndLoc (GETFILEPTR Stream))
(SETFILEPTR Stream StartLoc)
(NC.WritePtr Stream (DIFFERENCE EndLoc StartLoc)
3)
(SETFILEPTR Stream EndLoc)
(* * Now update the Index to reflect the new data just written. Done last in case the substance putting bombed for
some reason.)
(NC.SetTitleDirtyFlg Card)
(* * Now, since we were successful, we'll bind the PutSuccessfulLoc variable, which will be used freely by the
AFTER PutCardPartFns to determine first if the Put succeeded, and if so, where in the stream it was Put.)
(SETQ PutSuccessfulLoc StartLoc)
Card))))))
(NC.PutLinks
(LAMBDA (Card UseOldDateFlg) (* fgh: "31-Aug-86 22:59")
(* * Put the link data for ID onto the database file.)
(* * rht 1/30/85: Changed to use index array instead of file.)
(* * rht 7/9/85: Now puts out date after identifier. If UseOldDateFlg is non-nil, then use old date, otherwise use
current date.)
(* * rht 11/10/85: Updated to handle NoteFile and CardID scheme.)
(* * fgh 11/20/85 Added call to NC.WriteCardPartHeader and the mechanism to write the start and end pointers of the
substance before calling the card type's putfn.)
(* * rht 1/23/86: Now takes optional OverrideStream arg. This, if given, overrides stream of card's notefile.)
(* * kef 7/16/86: Makes use of the NoteFile device vector PutCardPartFn.)
(* * fgh 8/31/86 Adapated to use NC.DoCardPartFn.)
(* Check to make sure this is an active note card.)
(DECLARE (GLOBALVARS NC.LinksIdentifier))
(AND (NEQ (fetch (Card Status) of Card)
(QUOTE ACTIVE))
(NC.ReportError "NC.PutLinks" (CONCAT (NC.FetchTitle Card)
" is not an active note card.")))
(LET (PutSuccessfulLoc)
(WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(NC.DoCardPartFn Put Card (QUOTE LINKS)
(LET ((Stream (NC.CoerceToNoteFileStream Card))
StartLoc EndLoc)
(* * Write the links data at the end of the database file.)
(SETQ StartLoc (GETFILEPTR Stream))
(NC.WriteCardPartHeader Card NC.LinksIdentifier
(COND
(UseOldDateFlg (
NC.FetchLinksDate
Card))
(T (NC.SetLinksDate
Card
(DATE))))
Stream)
(NC.WriteListOfLinks Stream (NC.FetchToLinks Card))
(NC.WriteListOfLinks Stream (NC.FetchFromLinks
Card))
(NC.WriteListOfLinks Stream (NC.FetchGlobalLinks
Card))
(* * Update the length field at the beginning of the card info)
(SETQ EndLoc (GETFILEPTR Stream))
(SETFILEPTR Stream StartLoc)
(NC.WritePtr Stream (DIFFERENCE EndLoc StartLoc)
3)
(SETFILEPTR Stream EndLoc)
(* * Now update the index to point to the link data just written. Done last in case writing of links doesn't
complete okay.)
(NC.SetLinksDirtyFlg Card)
(* * Now, since we were successful, we'll bind the PutSuccessfulLoc variable, which will be used freely by the
AFTER PutCardPartFns to determine first if the Put succeeded, and if so, where in the stream it was Put.)
(SETQ PutSuccessfulLoc StartLoc)
Card))))))
(NC.PutPropList
(LAMBDA (Card UseOldDateFlg) (* fgh: "31-Aug-86 23:00")
(* * Put the prop list for ID onto the database file.)
(* * rht 1/30/85: Changed to use index array instead of file.)
(* * rht 7/9/85: Now puts out date after identifier. If UseOldDateFlg is non-nil, then use old date, otherwise use
current date.)
(* * rht 11/10/85: Updated to handle NoteFile and Card scheme.)
(* * fgh 11/20/85 Added call to NC.WriteCardPartHeader and the mechanism to write the start and end pointers of the
substance before calling the card type's putfn.)
(* * rht 1/23/86: Now takes optional OverrideStream arg. This, if given, overrides stream of card's notefile.)
(* * kef 7/16/86: Makes use of the NoteFile device vector PutCardPartFn.)
(* * fgh 8/31/86 Adapted to use NC.DoCardPartFn.)
(* Check to make sure this is an active note card.)
(DECLARE (GLOBALVARS NC.PropsIdentifier))
(AND (NEQ (fetch (Card Status) of Card)
(QUOTE ACTIVE))
(NC.ReportError "NC.PutPropList" (CONCAT (NC.FetchTitle Card)
" is not an active note card.")))
(LET (PutSuccessfulLoc)
(WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(NC.DoCardPartFn Put Card (QUOTE PROPLIST)
(LET ((Stream (NC.CoerceToNoteFileStream Card))
StartLoc EndLoc)
(* * Write the proplist at the end of the database file.)
(SETQ StartLoc (GETFILEPTR Stream))
(NC.WriteCardPartHeader Card NC.PropsIdentifier
(COND
(UseOldDateFlg (
NC.FetchPropListDate
Card))
(T (NC.SetPropListDate
Card
(DATE))))
Stream)
(NC.WritePropList Stream (NC.FetchPropList Card))
(* * Update the length field at the beginning of the card info)
(SETQ EndLoc (GETFILEPTR Stream))
(SETFILEPTR Stream StartLoc)
(NC.WritePtr Stream (DIFFERENCE EndLoc StartLoc)
3)
(SETFILEPTR Stream EndLoc)
(* * Now update the index to point to the proplist just written. Done last in case writing of proplist doesn't
complete okay.)
(NC.SetPropListDirtyFlg Card)
(* * Now, since we were successful, we'll bind the PutSuccessfulLoc variable, which will be used freely by the
AFTER PutCardPartFns to determine first if the Put succeeded, and if so, where in the stream it was Put.)
(SETQ PutSuccessfulLoc StartLoc)
Card))))))
(NC.GetNewCard
(LAMBDA (NoteFile Type) (* fgh: "31-Aug-86 23:10")
(* * See NCLocalDevice.NewCardUID.)
(* * kef 7/17/86: Updated to use the device vector function to grab an IndexLoc in the local case, and the UID in
all cases.)
(* * kef 8/4/86: Now takes Type argument and passes it onto the NewCardUIDFn)
(* * fgh 8/31/86 Changed APPLY* to NC.ApplyFn.)
(LET ((Card (create Card
NoteFile ← NoteFile))
ReturnValue)
(COND
((type? Card (SETQ ReturnValue (NC.ApplyFn NewCardUIDFn Card Type)))
(NC.InstallCardInNoteFile Card NoteFile))
(T (NC.ReportError (QUOTE NC.GetNewCard)
ReturnValue)))
Card)))
(NC.ReadOnlyNoteFileP
(LAMBDA (NoteFile) (* fgh: " 1-Sep-86 13:40")
(* * Return non-nil if notefile is open for read only.)
(* * fgh 9/1/86 Reimplemented in accordance with device vector implementation.)
(fetch (NoteFile ReadOnlyFlg) of NoteFile)))
)
[DECLARE: EVAL@COMPILE
(DATATYPE NoteFile (UID Stream FullFileName HashArray (HashArraySize FIXP)
(NextIndexNum FIXP)
(Version BYTE)
(NextLinkNum FIXP)
(CheckptPtr FIXP)
LinkLabelsCard TableOfContentsCard ToBeFiledCard OrphansCard RegistryCard
ReservedCards Menu MonitorLock ExclusiveAccessMonitor CachingProcess
IndexNumsFreeList UserProps ReadOnlyFlg NoteFileDevice)
(DATATYPE NoteFileDevice
(ListNoteFilesFn CreateNoteFileFn DeleteNoteFileFn OpenNoteFileFn
BuildHashArrayFn CloseNoteFileFn NoteFileOpenPFn
CheckpointNoteFileFn NewCardUIDFn MarkCardDeletedFn
GetCardInfoFn PutCardPartFn GetCardPartFn
ObtainWritePermissionFn ReleaseWritePermissionFn
CancelCacheSubscriptionFn RepairNoteFileFn CompactNoteFileFn
TruncateNoteFileFn ConvertNoteFileFormatFn))
(SYNONYM NoteFileDevice (Device)))
]
(/DECLAREDATATYPE (QUOTE NoteFileDevice)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER))
(QUOTE ((NoteFileDevice 0 POINTER)
(NoteFileDevice 2 POINTER)
(NoteFileDevice 4 POINTER)
(NoteFileDevice 6 POINTER)
(NoteFileDevice 8 POINTER)
(NoteFileDevice 10 POINTER)
(NoteFileDevice 12 POINTER)
(NoteFileDevice 14 POINTER)
(NoteFileDevice 16 POINTER)
(NoteFileDevice 18 POINTER)
(NoteFileDevice 20 POINTER)
(NoteFileDevice 22 POINTER)
(NoteFileDevice 24 POINTER)
(NoteFileDevice 26 POINTER)
(NoteFileDevice 28 POINTER)
(NoteFileDevice 30 POINTER)
(NoteFileDevice 32 POINTER)
(NoteFileDevice 34 POINTER)
(NoteFileDevice 36 POINTER)
(NoteFileDevice 38 POINTER)))
(QUOTE 40))
(/DECLAREDATATYPE (QUOTE NoteFile)
(QUOTE (POINTER POINTER POINTER POINTER FIXP FIXP BYTE FIXP FIXP POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER))
(QUOTE ((NoteFile 0 POINTER)
(NoteFile 2 POINTER)
(NoteFile 4 POINTER)
(NoteFile 6 POINTER)
(NoteFile 8 FIXP)
(NoteFile 10 FIXP)
(NoteFile 6 (BITS . 7))
(NoteFile 12 FIXP)
(NoteFile 14 FIXP)
(NoteFile 16 POINTER)
(NoteFile 18 POINTER)
(NoteFile 20 POINTER)
(NoteFile 22 POINTER)
(NoteFile 24 POINTER)
(NoteFile 26 POINTER)
(NoteFile 28 POINTER)
(NoteFile 30 POINTER)
(NoteFile 32 POINTER)
(NoteFile 34 POINTER)
(NoteFile 36 POINTER)
(NoteFile 38 POINTER)
(NoteFile 40 POINTER)
(NoteFile 42 POINTER)))
(QUOTE 44))
(* Changed functions from NCCARDS)
(DEFINEQ
(NC.QuitWithoutSaving
(LAMBDA (CardIdentifier) (* fgh: "30-Aug-86 00:09")
(* Quit from a note card without saving its contents on the database. But must make sure that any updates that
would have been done to this card even if it had been on the database are carried out on the old image currently on
the database)
(* * rht 2/1/85: Now only writes out links if it has to. Also resets dirty flags and calls normal quit procedure.
I think we've still got possible problems with recently changed titles, both ours and those of cards we point to.)
(* * rht 2/3/85: Now handles title changes properly. Also fixed so that changes to from links will force links to
be written.)
(* * rht 2/9/85: Now accepts IDs as arg.)
(* * fgh 11/12/85: Updated to handle Card objects. Removed DatabaseStream argument.)
(* * fgh 6/4/86 No longer asks for confirmation if no changes have been made.)
(* * kef 8/7/86: Now compares ToLinks by NC.SameUIDP rather than EQ. Situation comes up in Server, when the same
UIDs may not be EQ. Also, now obtains write lock on FROMLINKS before deleting FROMLINKS on the DestinationCard of a
changed FROMLINK.)
(* * fgh 8/30/86 Converted to use NC.WithWrotePermission macro.)
(LET (Window Card FromLinks ToLinks DeletedLinks Process TextObj MadeNewLinksP ChangedFromLinksP
OldFromLinks OldToLinks OperationInProgress)
(SETQ Card (NC.CoerceToCard CardIdentifier))
(SETQ Window (NC.FetchWindow Card))
(if (SETQ OperationInProgress (NC.OperationInProgress Card))
then
(* * Another interaction operation is in progress on this card and we have to interact with the user.
Can't do.)
(NC.PrintOperationInProgressMsg Window "Close w/o Saving" OperationInProgress)
else (NC.ProtectedCardOperation Card Close% wo% Saving (SETQ FromLinks (
NC.FetchFromLinks Card))
(SETQ ToLinks (NC.FetchToLinks Card))
(COND
((OR (NULL (OR (NC.CardDirtyP Card)
(NC.FetchLinksDirtyFlg Card)
(NC.FetchTitleDirtyFlg Card)
(NC.FetchPropListDirtyFlg
Card)))
(NC.AskYesOrNo
"Are you sure you want to flush your changes?"
" -- " "Yes" T Window NIL NIL))
(* * EIther no changes have been made or the user has confirmed.)
(COND
((NC.CardP (NC.GetNoteCard Card))
(* If from links have changed then we'll have to write
the new ones out.)
(SETQ OldFromLinks (NC.FetchFromLinks Card))
(COND
((NOT (NC.SameLinksP FromLinks
OldFromLinks))
(NC.SetFromLinks Card FromLinks)
(SETQ ChangedFromLinksP T)))
(* Delete the back links from all links that are not
in the old to link set.)
(SETQ OldToLinks (NC.FetchToLinks Card))
(for ToLink in ToLinks
when
(NOT (for Link in OldToLinks
bind (ToLinkID
←(fetch (Link UID)
of ToLink))
thereis
(NC.SameUIDP
ToLinkID
(fetch (Link UID)
of Link))
eachtime (BLOCK)))
do (LET ((DestinationCard
(fetch (Link DestinationCard)
of ToLink)))
(* Grab the writelock on the FROMLINKS before trying
to write out the change.)
(NC.WithWritePermission
DestinationCard FROMLINKS
(NC.DelFromLink ToLink T)
(SETQ MadeNewLinksP T))))
(* Check to make sure none of the old To links point
to a deleted card. If so, replace with a deleted
marker.)
(SETQ DeletedLinks
(bind DestinationCard for Link
in OldToLinks
when (PROGN (SETQ DestinationCard
(fetch (Link
DestinationCard)
of Link))
(AND (NOT (
NC.ActiveCardP
DestinationCard))
(EQ (QUOTE
DELETED)
(
NC.FetchStatus
DestinationCard))))
eachtime (BLOCK)
collect (NC.DelReferencesToCard Card
DestinationCard)
Link))
(NC.SetToLinks Card (LDIFFERENCE OldToLinks
DeletedLinks))
(* Mark links dirty if we had to delete any to links
or if the from links changed.)
(NC.SetLinksDirtyFlg Card (OR DeletedLinks
ChangedFromLinksP))
(* Mark the substance dirty if had to delete any to
links.)
(COND
(DeletedLinks (NC.MarkCardDirty Card))
(T (NC.MarkCardDirty Card (QUOTE RESET))))
(NC.SetPropListDirtyFlg Card NIL)
(COND
((NC.FetchTitleDirtyFlg Card)
(* If we've changed title and any of the cards pointing to this one are up on the screen, then we need to update
their images.)
(for FromLink in OldFromLinks
bind SourceCard eachtime (BLOCK)
when
(AND (NC.ActiveCardP
(SETQ SourceCard
(fetch (Link SourceCard)
of FromLink)))
(WINDOWP (NC.FetchWindow
SourceCard)))
do (NC.UpdateLinkImages SourceCard
Card))
(NC.SetTitleDirtyFlg Card NIL)))
(NC.QuitCard Card T T NIL T))
(T (* If the card has never been written to the database
quit w/o saving is equivalent to deleting the card.)
(NC.PrintMsg Window T
"This card has never been saved."
(CHARACTER 13)
"It will be deleted from the database."
(CHARACTER 13))
(NC.DeleteNoteCards Card NIL T))))))))))
(NC.DeactivateCard
(LAMBDA (Card DeleteTypeAndTitleFlg) (* fgh: "30-Aug-86 00:11")
(* * Remove all the information from the prop list of the NoteCard ID, except for the title which usually statys
cached.)
(* * rht 7/9/85: Now also removes the new date properties.)
(* * fgh 10/15/85 altered to use new caching mechanism)
(* * rht 11/10/85: Updated to handle CardID scheme and new version of NC.FetchCardCache.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * kef 7/16/86: Added the release of the write permission and cancel cache subscription.)
(* * fgh 8/30/86 Converted APPLY* to NC.ApplyFn.)
(replace (Card ActiveFlg) of Card with NIL)
(replace (Card CardCache) of Card with NIL)
(for CardPart in (QUOTE (SUBSTANCE TOLINKS GLOBALTOLINKS PROPLIST))
do (NC.ApplyFn ReleaseWritePermissionFn Card CardPart)
(NC.ApplyFn CancelCacheSubscriptionFn Card CardPart))
(if DeleteTypeAndTitleFlg
then (replace (Card Type) of Card with NIL)
(replace (Card Title) of Card with NIL)
(NC.ApplyFn CancelCacheSubscriptionFn Card (QUOTE TITLE)))))
(NC.MakeNoteCard
(LAMBDA (NoteCardType NoteFile Title NoDisplayFlg TypeSpecificArgs Card)
(* Feuerman " 4-Aug-86 14:11")
(* Make a new note card of type NoteCardType.
If type note specified, ask the user.)
(* * rht 2/1/85: Added call to NC.MarkCardDirty.)
(* * fgh 10/15/85 Added extra DatabaseStream argument for use by caching mechanism)
(* * 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/4/86: Now checks for read-only notefile before proceeding.)
(* * kef 8/4/86: Updated to pass NoteCardType argument on to NC.GetNewCard.)
(if (NC.ReadOnlyNoteFileP NoteFile)
then NIL
else (LET (ReturnValue Window)
(COND
((SETQ NoteCardType (OR NoteCardType (NC.AskNoteCardType
(fetch (NoteFile Menu) of NoteFile))))
(SETQ Card (OR (PROGN (type? Card Card)
Card)
(NC.GetNewCard NoteFile NoteCardType)))
(NC.SetNewCardFlg Card T)
(NC.ActivateCard Card)
(NC.SetType Card NoteCardType)
(COND
((OR (NULL (ERSETQ (SETQ ReturnValue (NC.ApplyFn MakeFn Card Title
NoDisplayFlg
TypeSpecificArgs))))
(NULL ReturnValue))
(NC.SetStatus Card (QUOTE DELETED))
(NC.DeactivateCard Card T))
(T (SETQ Window (WINDOWP ReturnValue))
(COND
((NULL (NC.RetrieveTitle Card))
(SETQ Title (NC.SetTitle Card (SETQ Title
(COND
((STRINGP Title)
Title)
((AND Title (OR (LITATOM Title)
(NUMBERP Title))
)
(MKSTRING Title))
(T "Untitled")))))
(AND Window (WINDOWPROP Window (QUOTE TITLE)
Title)))
(T (NC.SetTitle Card (MKSTRING (NC.RetrieveTitle Card)))))
(COND
(Window (WINDOWADDPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.QuitCard)
(QUOTE FIRST))
(WINDOWPROP Window (QUOTE NoteCardObject)
Card)
(WINDOWPROP Window (QUOTE OldCopyButtonEventFn)
(WINDOWPROP Window (QUOTE COPYBUTTONEVENTFN)
(FUNCTION NC.CopyButtonEventFn)))))
(NC.SetTitleDirtyFlg Card T) (* Reset the type in case of recursive calls change
the type. Always want the highest level type in a
recursive descent)
(NC.SetType Card NoteCardType)
(* Insure that a link ptr is set up during the first
save)
(NC.SetLinksDirtyFlg Card T)
(NC.SetPropListDirtyFlg Card T)
(* Mark that substance is dirty.)
(NC.MarkCardDirty Card T)
(if NC.ShowNoteFileOnCards
then (NC.AttachNoteFileName Window))))
ReturnValue))))))
(NC.AssignTitle
(LAMBDA (CardIdentifier NoClearMsgFlg NewTitle) (* fgh: "30-Aug-86 23:47")
(* * Change the title of the card specified by the WindowOrTextStreamOrID)
(* * rht 2/1/85: Changed from NC.PutTitle to NC.SetTitleDirtyFlg, unless card is not active.
We shouldn't be writing to the notefile until save time.)
(* * fgh 11/11/85: Added support for CardID, CardInfo and noteFile objects. Also entered call to Nc.StoreTitle.)
(* * fgh 6/9/86 Added code to check to make sure that another operation is not in progress on this card when this
fn is called.)
(* * fgh 6/13/86 Now spawns mouse in case called under MOUSE process.)
(* * fgh 6/27/86 returns T if completed okay.)
(* * rht 7/4/86: Added check for readonly card.)
(* * kef 7/16/86: Added obtain write permission.)
(* * kef 7/24/86: Doesn't release the write lock if this is a new card.)
(* * 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.)
(* * fgh 8/30/86 Converted to use NC.IfCardPartNotBusy.)
(ALLOW.BUTTON.EVENTS)
(LET ((Card (NC.CoerceToCard CardIdentifier))
ContainingCard OldTitle Window OperationInProgress)
(NC.IfCardPartNotBusy
Card
(QUOTE TITLE)
(SETQ Window (NC.FetchWindow Card))
(if (NC.CheckForNotReadOnly Card Window "Can't change titles for cards in ")
then (if (AND (NULL NewTitle)
(SETQ OperationInProgress (NC.OperationInProgress Card)))
then
(* * Another interaction operation is in progress on this card and we have to interact with the user.
Can't do.)
(NC.PrintOperationInProgressMsg Window "Assign Title"
OperationInProgress)
else (NC.ProtectedCardOperation
Card AssignTitle (COND
((SETQ NewTitle (OR (STRINGP NewTitle)
(AND NewTitle (OR (LITATOM NewTitle)
(NUMBERP NewTitle))
(MKSTRING NewTitle))
(NC.AskUser
(CONCAT
"Enter the title for this card"
(CHARACTER 13))
"--> "
(COND
((AND (STREQUAL (SETQ OldTitle
(
NC.RetrieveTitle
Card))
"Untitled")
(NC.FetchNewCardFlg Card))
NIL)
(T OldTitle))
(NULL NoClearMsgFlg)
Window)))
(NC.SetTitle Card NewTitle)
(* * Now do a PutTitle so that anyone else coming along will pick up on the new title. The only exception is if
this card hasn't been written to the NoteFile yet, which is true when the NewCardFlg is T. In that case, we can't
put the title down yet, so just mark it dirty.)
(COND
((fetch (Card NewCardFlg) of Card)
(NC.SetTitleDirtyFlg Card T))
(T (NC.PutTitle Card)
(NC.SetTitleDirtyFlg Card NIL)))
(AND (WINDOWP Window)
(WINDOWPROP Window (QUOTE TITLE)
NewTitle))
(for FromLink in (NC.RetrieveFromLinks Card)
do (AND (NC.ActiveCardP (SETQ ContainingCard
(fetch (Link SourceCard)
of FromLink)))
(WINDOWP (NC.FetchWindow ContainingCard))
(NC.UpdateLinkImages ContainingCard Card)))))))
T
else NIL)))))
(NC.EditNoteCard
(LAMBDA (Card Region/Position TypeSpecificArgs) (* fgh: "30-Aug-86 00:26")
(* * Bring the already created NoteCard specified by ID onto the screen at Region or Position specified by
Region/Position)
(* * 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.)
(DECLARE (GLOBALVARS NC.ShowNoteFileOnCards))
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(PROG (NoteCardType 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))))))
(SETQ NoteCardType (NC.RetrieveType Card))
(COND
((AND (SETQ EditResult (ERSETQ (NC.ApplyFn EditFn Card Substance
Region/Position
TypeSpecificArgs)))
(WINDOWP (SETQ Window (CAR EditResult))))
(WINDOWADDPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.QuitCard)
(QUOTE FIRST))
(WINDOWPROP Window (QUOTE NoteCardObject)
Card)
(WINDOWPROP Window (QUOTE OldCopyButtonEventFn)
(WINDOWPROP Window (QUOTE COPYBUTTONEVENTFN)
(FUNCTION NC.CopyButtonEventFn)))
(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)))
(RETURN Window)))))
(NC.ClosePropListEditor
(LAMBDA (Window SaveFlg) (* fgh: "30-Aug-86 00:46")
(* Close the prop list editor, saving or not saving the edited prop list as specified by the SaveFlg or by the user
if SaveFlg is NIL)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * fgh 6/8/86 Added call to RAPOSITIONATTACHEDWINDOWS)
(* * rht 8/12/86 Now uses TEXTOBJ to get TextObj from window.)
(* * kef 7/16/86: Added the call to release the write permission should the window property declare that it be
necessary.)
(* * kef 7/22/86: Now only releases the write permission if the card is inactive. The reason is that it was
determined that a card being edited would update the property list upon being closed.)
(* * fgh 8/30/86 Converted APPLY* to NC.ApplyFn. Added Card local var.)
(DECLARE (GLOBALVARS NC.SavePropEditMenu))
(PROG (TextObj Answered OldPropList NewPropList MainWindow Card)
(SETQ MainWindow (WINDOWPROP Window (QUOTE MAINWINDOW)))
(DETACHWINDOW Window)
(SETQ TextObj (CAR (NLSETQ (TEXTOBJ Window))))
(SETQ OldPropList (WINDOWPROP Window (QUOTE PROPERTYLIST.BEING.EDITED)))
(AND TextObj (COND
((EQ SaveFlg (QUOTE Save))
(SETQ NewPropList (NC.ExtractPropList Window))
(NC.ProcessEditedPropList NewPropList OldPropList (NC.CoerceToCard
MainWindow)))
((EQ SaveFlg (QUOTE NoSave)))
((EQ (WINDOWPROP Window (QUOTE PropListEditor))
(QUOTE ShowOnly)))
(T (until Answered do (SELECTQ (MENU
(OR (AND (BOUNDP (QUOTE
NC.SavePropEditMenu))
(type? MENU
NC.SavePropEditMenu)
NC.SavePropEditMenu)
(SETQ NC.SavePropEditMenu
(create MENU
ITEMS ←(QUOTE
(Save% Changes
Cancel% Changes))
TITLE ←
"Property Edits?"
CENTERFLG ← T))))
(Save% Changes (SETQ NewPropList
(NC.ExtractPropList
Window))
(NC.ProcessEditedPropList
NewPropList OldPropList
(NC.CoerceToCard
MainWindow))
(SETQ Answered T))
(Cancel% Changes (SETQ Answered T))
NIL)))))
(WINDOWPROP Window (QUOTE TEDIT.MENU)
NIL)
(WINDOWPROP Window (QUOTE TEDIT.PROPS)
NIL)
(WINDOWPROP Window (QUOTE PropListEditor)
NIL)
(WINDOWDELPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.ClosePropListEditor))
(COND
((AND (WINDOWPROP Window (QUOTE ReleaseWritePermissionP))
(NOT (NC.ActiveCardP (SETQ Card (NC.CoerceToCard MainWindow)))))
(NC.ApplyFn ReleaseWritePermissionFn Card (QUOTE PROPLIST))
(WINDOWPROP Window (QUOTE ReleaseWritePermissionP)
NIL)))
(COND
(TextObj (replace (TEXTOBJ \DIRTY) of TextObj with NIL)
(\TEDIT.QUIT (CAR (MKLIST (fetch (TEXTOBJ \WINDOW) of TextObj))))
(until (fetch (TEXTOBJ EDITFINISHEDFLG) of TextObj) do (BLOCK))))
(ADD.PROCESS (BQUOTE (PROGN (until (NULL (OPENWP , Window)) do (BLOCK))
(REPOSITIONATTACHEDWINDOWS , MainWindow)))))))
(NC.EditProperties
(LAMBDA (TextStream) (* fgh: "30-Aug-86 00:48")
(* Open a property list editor for the card
corresponding to TextStream.
Called from Title bar menus.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * rht 4/11/86: No longer sticks dates and Updates in property list. Only user-defined stuff.)
(* * kef 7/22/86: Added call to card's obtain write permission function for the PROPLIST.)
(* * fgh 8/30/86 Converted APPLY* to NC.ApplyFn.)
(LET ((Card (NC.CoerceToCard (WINDOW.FROM.TEDIT.THING TextStream)))
PropList PropEditorWindow)
(SETQ PropList (NC.FetchPropList Card))
(COND
((NC.ApplyFn ObtainWritePermissionFn Card (QUOTE PROPLIST))
(WINDOWPROP (SETQ PropEditorWindow (NC.OpenPropListEditor
TextStream
(for SubList on PropList by (CDDR SubList)
when (NEQ (CAR SubList)
(QUOTE Updates))
join (LIST (CAR SubList)
(CADR SubList)))
"Edit Property List"))
(QUOTE ReleaseWritePermissionP)
T)
PropEditorWindow)
(T (NC.CardPartBusy Card (QUOTE PROPLIST)))))))
(NC.CardSaveFn
(LAMBDA (WindowOrID QuietFlg DontCheckForOpsInProgressFlg InterestedWindow OperationMsg)
(* fgh: "30-Aug-86 00:53")
(* * 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.)
(LET ((Card (NC.CoerceToCard WindowOrID))
Window OldRegion NewRegion DoneAPutP OperationInProgress)
(SETQ Window (NC.FetchWindow Card))
(SETQ InterestedWindow (OR Window InterestedWindow))
(if (NC.CheckForNotReadOnly Card Window "Can't save cards in ")
then (if (AND (NULL DontCheckForOpsInProgressFlg)
(SETQ OperationInProgress (NC.OperationInProgress Card))
(NEQ OperationInProgress (QUOTE Close% Card)))
then (NC.PrintOperationInProgressMsg Window "Save Card"
OperationInProgress)
else (NC.ProtectedCardOperation
Card Save% Card (OR QuietFlg (NC.PrintMsg InterestedWindow T
(OR OperationMsg "")
(NC.FetchTitle Card)
": Checking ... "))
(COND
((OR (NC.CardDirtyP Card)
(NC.FetchNewCardFlg Card))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "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)))))
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL
"Saving "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "region, "))
(NC.PutRegion Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchTitleDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL
"Saving "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "title, "))
(NC.PutTitle Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchPropListDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL
"Saving "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "proplist, "))
(NC.PutPropList Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchLinksDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL
"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))))
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL
(CHARACTER 13)
"Nothing changed. "))
(* It's not a new card anymore.)
(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 (PROGN (NC.PrintMsg InterestedWindow NIL "Done."
(CHARACTER 13))
(if Window
then (NC.ClearMsg Window T))))))))))
(NC.DeleteNoteCard
(LAMBDA (Card) (* fgh: "30-Aug-86 01:14")
(* * Delete a single note card from a NoteFile)
(* * rht 8/11/86 Now calls NC.DeleteReferencesToCardFromShowLinks to smash any link icons in show links menus
pointing to this card.)
(* * kef 7/28/86: Added code to obtain all of the write locks deemed necessary.)
(* * 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/31/86: Added the nesting of the obtaining writelocks with deactivating the card.)
(* * fgh 8/30/86 Translated APPLY* to NC.ApplyFn. Made cosmetic changes in FOR loop concewrning WriteLocks.)
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(RESETSAVE NIL (BQUOTE (NC.SetBeingDeletedFlg , Card NIL)))
(WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(LET ((WriteLocks (for CardPart
in (QUOTE (SUBSTANCE TITLE TOLINKS FROMLINKS
GLOBALTOLINKS PROPLIST))
collect (CONS Card CardPart)))
ToLinks FromLinks Window BusyPart PromptWindow)
(NC.SetBeingDeletedFlg Card T)
(SETQ ToLinks (NC.RetrieveToLinks Card))
(SETQ FromLinks (NC.RetrieveFromLinks Card))
(for ToLink in ToLinks
do (NCONC WriteLocks (for CardPart
in (QUOTE (TOLINKS FROMLINKS
GLOBALTOLINKS))
collect
(CONS (fetch (Link
DestinationCard)
of ToLink)
CardPart))))
(for FromLink in FromLinks
do (NCONC WriteLocks (for CardPart
in (QUOTE (SUBSTANCE TOLINKS
FROMLINKS
GLOBALTOLINKS))
collect
(CONS (fetch (Link SourceCard)
of FromLink)
CardPart))))
(* * The for... loop that follows is the condition that we can obtain all of the write locks on all of the card
parts collected in WriteLocks. If we obtain a writelock, setup a RESETSAVE to release it upon exit.
Then finally, if we do obtain a write lock, return T so that the for loop's "always" condition is satisfied.
If we don't obtain a write lock for a given card part, save that one as a variable so we can report it to the user.
Then return NIL, so that the for loop's "always" condition is not satisfied, and we bump out of the for loop.)
(NC.PrintMsg (SETQ PromptWindow (NC.AttachPromptWindow
(NC.FetchWindow Card)))
T "Collecting write locks...")
(COND
((bind WLCard WLCardPart for WriteLock in WriteLocks
always (SETQ WLCard (CAR WriteLock))
(SETQ WLCardPart (CDR WriteLock))
(COND
((NC.ApplyFn ObtainWritePermissionFn WLCard
WLCardPart)
(RESETSAVE NIL
(BQUOTE
(APPLY* , (fetch
(Card
ReleaseWritePermissionFn)
of WLCard)
, WLCard , WLCardPart))
)
T)
(T (SETQ BusyPart WriteLock)
NIL)))
(* * Call off to the MarkCardDeletedFn specific to the NoteFile.)
(RESETSAVE (for CardPart
in (QUOTE (SUBSTANCE TOLINKS GLOBALTOLINKS
PROPLIST))
do (NC.ApplyFn ObtainWritePermissionFn Card
CardPart))
(BQUOTE (NC.DeactivateCard , Card T)))
(NC.ApplyFn MarkCardDeletedFn Card)
(NC.SetToLinks Card NIL)
(NC.SetFromLinks Card NIL)
(NC.PrintMsg PromptWindow NIL
"Removing links to and from other cards...")
(for ToLink in ToLinks
do (NC.DelFromLink ToLink)
(NC.DelReferencesToCardFromShowLinks
(fetch (Link DestinationCard) of ToLink)
ToLink))
(for FromLink in FromLinks
do (NC.DelToLink FromLink)
(NC.DelReferencesToCard (fetch (Link SourceCard)
of FromLink)
Card)
(NC.DelReferencesToCardFromShowLinks
(fetch (Link SourceCard) of FromLink)
FromLink))
(NC.PrintMsg PromptWindow NIL "..done.")
(COND
((NC.ActiveCardP Card)
(NC.TurnOffDirtyFlgs Card)
(SETQ Window (NC.FetchWindow Card))
(AND Window (NC.GreyCard Card))
(NC.CloseAllPropListEditors Card)
(NC.QuitCard Card T T NIL T)))
(NC.SetNewCardFlg Card NIL))
(T (NC.CardPartBusy (CAR BusyPart)
(CDR BusyPart)
PromptWindow))))))))
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS Card (
(* * Instance variables of the card object)
(UID (fetch (CardObject UID) of DATUM)
(replace (CardObject UID) of DATUM with NEWVALUE))
(NoteFile (LET ((\NF (fetch (CardObject NoteFile) of DATUM)))
(COND
((type? NoteFile \NF)
\NF)
(\NF (replace (CardObject NoteFile) of DATUM
with (NC.NoteFileFromNoteFileUID \NF)))))
(replace (CardObject NoteFile) of DATUM with NEWVALUE))
(Monitor (fetch (CardObject Monitor) of DATUM)
(replace (CardObject Monitor) of DATUM with NEWVALUE))
(Status (fetch (CardObject Status) of DATUM)
(replace (CardObject Status) of DATUM with NEWVALUE))
(IndexDirtyFlg (fetch (CardObject IndexDirtyFlg) of DATUM)
(replace (CardObject IndexDirtyFlg) of DATUM with NEWVALUE))
(IndexLoc (fetch (CardObject IndexLoc) of DATUM)
(replace (CardObject IndexLoc) of DATUM with NEWVALUE))
(MainLoc (fetch (CardObject MainLoc) of DATUM)
(replace (CardObject MainLoc) of DATUM with NEWVALUE))
(LinksLoc (fetch (CardObject LinksLoc) of DATUM)
(replace (CardObject LinksLoc) of DATUM with NEWVALUE))
(PropListLoc (fetch (CardObject PropListLoc) of DATUM)
(replace (CardObject PropListLoc) of DATUM with NEWVALUE))
(TitleLoc (fetch (CardObject TitleLoc) of DATUM)
(replace (CardObject TitleLoc) of DATUM with NEWVALUE))
(Title (fetch (CardObject Title) of DATUM)
(replace (CardObject Title) of DATUM with NEWVALUE))
(TitleDirtyFlg (fetch (CardObject TitleDirtyFlg) of DATUM)
(replace (CardObject TitleDirtyFlg) of DATUM with NEWVALUE))
(* Note the use of NC.GetType if CardType is NIL. This is required to force the access to go to the disk for the
card type if the card type caching process is not finished before this fetch is being made.
Sort of a kludge.)
(Type (OR (fetch (CardObject Type) of DATUM)
(NC.GetType DATUM))
(replace (CardObject Type) of DATUM with NEWVALUE))
(ActiveFlg (fetch (CardObject ActiveFlg) of DATUM)
(replace (CardObject ActiveFlg) of DATUM with NEWVALUE))
(ActiveCardFlg (fetch (CardObject ActiveFlg) of DATUM)
(replace (CardObject ActiveFlg) of DATUM with NEWVALUE))
(CardCache (fetch (CardObject CardCache) of DATUM)
(replace (CardObject CardCache) of DATUM with NEWVALUE))
(UserData (fetch (CardObject UserData) of DATUM)
(replace (CardObject UserData) of DATUM with NEWVALUE))
(Substance (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache Substance) of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache Substance) of \Cache
with NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
Substance ← NEWVALUE))
NEWVALUE))))
(Links (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache Links) of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache Links) of \Cache with NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
Links ← NEWVALUE))
NEWVALUE))))
(FromLinks (LET ((\Cache (fetch (CardObject CardCache) of DATUM))
\Links)
(AND \Cache (SETQ \Links (fetch (CardCache Links)
of \Cache))
(fetch (LinksCache FromLinks) of \Links)))
(LET ((\Cache (OR (fetch (CardObject CardCache) of DATUM)
(replace (CardObject CardCache) of DATUM
with (create CardCache))))
\Links)
(SETQ \Links (fetch (CardCache Links) of \Cache))
(COND
(\Links (replace (LinksCache FromLinks) of \Links
with NEWVALUE))
(T (replace (CardCache Links) of \Cache
with (create LinksCache
FromLinks ← NEWVALUE))
NEWVALUE))))
(ToLinks (LET ((\Cache (fetch (CardObject CardCache) of DATUM))
\Links)
(AND \Cache (SETQ \Links (fetch (CardCache Links)
of \Cache))
(fetch (LinksCache ToLinks) of \Links)))
(LET ((\Cache (OR (fetch (CardObject CardCache) of DATUM)
(replace (CardObject CardCache) of DATUM
with (create CardCache))))
\Links)
(SETQ \Links (fetch (CardCache Links) of \Cache))
(COND
(\Links (replace (LinksCache ToLinks) of \Links with
NEWVALUE))
(T (replace (CardCache Links) of \Cache
with (create LinksCache
ToLinks ← NEWVALUE))
NEWVALUE))))
(GlobalLinks (LET ((\Cache (fetch (CardObject CardCache) of DATUM))
\Links)
(AND \Cache (SETQ \Links (fetch (CardCache Links)
of \Cache))
(fetch (LinksCache GlobalLinks) of \Links)))
(LET ((\Cache (OR (fetch (CardObject CardCache) of DATUM)
(replace (CardObject CardCache) of DATUM
with (create CardCache))))
\Links)
(SETQ \Links (fetch (CardCache Links) of \Cache))
(COND
(\Links (replace (LinksCache GlobalLinks) of \Links
with NEWVALUE))
(T (replace (CardCache Links) of \Cache
with (create LinksCache
GlobalLinks ← NEWVALUE))
NEWVALUE))))
(PropList (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache PropList) of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache PropList) of \Cache with
NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
PropList ← NEWVALUE))
NEWVALUE))))
(Region (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache Region) of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache Region) of \Cache with NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
Region ← NEWVALUE))
NEWVALUE))))
(SavedRegion (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache SavedRegion) of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache SavedRegion) of \Cache
with NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
SavedRegion ← NEWVALUE))
NEWVALUE))))
(ItemDate (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache ItemDate) of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache ItemDate) of \Cache with
NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
ItemDate ← NEWVALUE))
NEWVALUE))))
(LinksDate (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache LinksDate) of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache LinksDate) of \Cache
with NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
LinksDate ← NEWVALUE))
NEWVALUE))))
(TitleDate (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache TitleDate) of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache TitleDate) of \Cache
with NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
TitleDate ← NEWVALUE))
NEWVALUE))))
(PropListDate (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache PropListDate) of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache PropListDate) of \Cache
with NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
PropListDate ← NEWVALUE))
NEWVALUE))))
(LinksDirtyFlg (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache LinksDirtyFlg) of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache LinksDirtyFlg) of \Cache
with NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
LinksDirtyFlg ← NEWVALUE))
NEWVALUE))))
(PropListDirtyFlg (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache PropListDirtyFlg)
of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache PropListDirtyFlg)
of \Cache with NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
PropListDirtyFlg ← NEWVALUE))
NEWVALUE))))
(SubstanceDirtyFlg (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache SubstanceDirtyFlg)
of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache SubstanceDirtyFlg)
of \Cache with NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
SubstanceDirtyFlg ← NEWVALUE))
NEWVALUE))))
(NewCardFlg (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache NewCardFlg) of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache NewCardFlg) of \Cache
with NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
NewCardFlg ← NEWVALUE))
NEWVALUE))))
(BeingDeletedFlg (LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(AND \Cache (fetch (CardCache BeingDeletedFlg)
of \Cache)))
(LET ((\Cache (fetch (CardObject CardCache) of DATUM)))
(COND
(\Cache (replace (CardCache BeingDeletedFlg)
of \Cache with NEWVALUE))
(T (replace (CardObject CardCache) of DATUM
with (create CardCache
BeingDeletedFlg ← NEWVALUE))
NEWVALUE))))
(* * Class variables of the card object {class == card type})
(SuperType (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField SuperType NoteCardType)))
(LinkDisplayMode (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField LinkDisplayMode NoteCardType)))
(DefaultWidth (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField DefaultWidth NoteCardType)))
(DefaultHeight (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField DefaultHeight NoteCardType)))
(LinkAnchorModesSupported (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField LinkAnchorModesSupported
NoteCardType)))
(LinkIconAttachedBitMap (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField LinkIconAttachedBitMap
NoteCardType)))
(LeftButtonMenuItems (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField LeftButtonMenuItems NoteCardType)))
(MiddleButtonMenuItems (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField MiddleButtonMenuItems
NoteCardType)))
(* * Methods of the card object {class == card type})
(MakeFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField MakeFn NoteCardType)))
(EditFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField EditFn NoteCardType)))
(QuitFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField QuitFn NoteCardType)))
(GetFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField GetFn NoteCardType)))
(PutFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField PutFn NoteCardType)))
(CopyFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField CopyFn NoteCardType)))
(MarkDirtyFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField MarkDirtyFn NoteCardType)))
(DirtyPFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField DirtyPFn NoteCardType)))
(CollectLinksFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField CollectLinksFn NoteCardType)))
(DeleteLinksFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField DeleteLinksFn NoteCardType)))
(UpdateLinkIconsFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField UpdateLinkIconsFn NoteCardType)))
(InsertLinkFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField InsertLinkFn NoteCardType)))
(TranslateWindowPositionFn (LET ((NoteCardType (fetch (Card Type) of DATUM)))
(NC.GetCardTypeField TranslateWindowPositionFn
NoteCardType)))
(* * Methods inherited from the cards current NoteFile device)
(MarkCardDeletedFn (fetch (NoteFile MarkCardDeletedFn)
of (fetch (Card NoteFile) of DATUM)))
(GetCardInfoFn (fetch (NoteFile GetCardInfoFn) of (fetch (Card NoteFile)
of DATUM)))
(PutCardPartFn (fetch (NoteFile PutCardPartFn) of (fetch (Card NoteFile)
of DATUM)))
(GetCardPartFn (fetch (NoteFile GetCardPartFn) of (fetch (Card NoteFile)
of DATUM)))
(ObtainWritePermissionFn (fetch (NoteFile ObtainWritePermissionFn)
of (fetch (Card NoteFile) of DATUM)))
(ReleaseWritePermissionFn (fetch (NoteFile ReleaseWritePermissionFn)
of (fetch (Card NoteFile) of DATUM)))
(CancelCacheSubscriptionFn (fetch (NoteFile CancelCacheSubscriptionFn)
of (fetch (Card NoteFile) of DATUM))))
(CREATE (create CardObject))
(TYPE? (TYPE? CardObject DATUM)))
]
(* Changed functions from NCINTERFACE)
(DEFINEQ
(NC.CloseNoteFile
(LAMBDA (NoteFile InterestedWindow Don'tCheckOperationInProgressFlg QuietFlg)
(* fgh: " 1-Sep-86 13:43")
(* * Close a NoteFIle)
(* * rht 10/23/84: Now gives user option of closing and saving all open cards on the screen.)
(* * rht 11/8/84: Put RESETLST around NC.CacheTitles call.)
(* * rht 1/9/85: Clear the NC.UncachingNotCompleted variable when close successfully completes.)
(* * rht 1/31/85: Added call to checkpoint database. That in turn dumps the next nodeID and next linkID.)
(* * 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 10/16/85 removed call to CacheTypesAndTitles because uncacheing now done automatically by cache
mechanism.)
(* * fkr 10/29/85: Now kills caching process from database streamprop.)
(* * fkr 11/8/85 Updated to handle new NoteFile object and new CardID scheme.)
(* * kirk 23Jan86 Changed to use NC.AskYesOrNo)
(* * rht 3/26/86: Now searches for active cards over whole notefile not just among cards up on screen.
Uses NC.MapCards.)
(* * kirk 28Apr86 Now returns NoteFile if successful.)
(* * fgh 5/2/86 Cleaned up. Ask user to confirm only if there are cards on the screen, not if there are active, but
not displayed ones. Added calls to the NC.CloseNoteFileFns before and after the closeing.)
(* * fgh 5/26/86 Revamp for device vector implementation.)
(* * kef 7/24/86: Changed the last expression at the end that smashes the NoteFile device out of the NoteFile data
structure. This is so that the Interface will not bomb trying to apply an OPENP function with a NIL Device.)
(* * kef 8/4/86: Added something to obtain the write lock on the parts of the active NoteCards that deactivating
will release. This is also so that any changes may be written to the server.)
(* * fgh 8/31/86 Reimplemented changes in system made since 5/23/86 conversion. Reimplemented changes include:
(* * fgh 6/4/86 Fixed so that shrunken cards are counted as open when asking for confirmation when there are open
cards on screen.) (* * fgh 6/13/86 Now checks for card operations in progress and kills them if necessary.)
(* * fgh 6/25/86 Added NC.ProtectedNoteFileOperation macro call. Added Don'tCheckOperationInProgressFlg args.)
(* * rht 7/4/86: Added check for readonly notefile.) (* * rht 7/13/86: Added QuietFlg arg. Note that this will
cause open cards on the screen to be closed and saved without asking user for confirmation.))
(DECLARE (GLOBALVARS NC.CloseNoteFileFns))
(if (NC.ReadOnlyNoteFileP NoteFile)
then (NC.AbortSession NoteFile InterestedWindow)
else
(ALLOW.BUTTON.EVENTS)
(PROG (CardTotal ActiveCards ReturnValue (OperationMsg ""))
(OR InterestedWindow (if (type? MENU (fetch (NoteFile Menu) of NoteFile))
then (SETQ InterestedWindow (WFROMMENU
(fetch (NoteFile Menu) of NoteFile)))))
(* * Make sure NF is open)
(if (NULL (ERSETQ (SETQ ReturnValue (APPLY* (fetch (NoteFile
NoteFileOpenPFn)
of NoteFile)
NoteFile))))
then (SETQ ReturnValue (QUOTE OpenPFailed)))
(if (NULL ReturnValue)
then
(* * NoteFile is not open.)
(NC.PrintMsg InterestedWindow T (fetch (NoteFile FullFileName)
of NoteFile)
" is not an open NoteFile!!!"
(CHARACTER 13))
(RETURN NIL)
elseif (NOT (type? NoteFile ReturnValue))
then
(* * Error return from NoteFileOpenPFn)
(if (NULL (ERSETQ (NC.ReportError NIL (CONCAT
"OpenP test on "
(fetch (NoteFile FullFileName)
of NoteFile)
"failed because " ReturnValue
(CHARACTER 13)
"OK to continue Close. ↑ to abort Close."))))
then (RETURN ReturnValue)))
(* * Check to see if this NoteFile is busy doing something else)
(if (AND (NULL Don'tCheckOperationInProgressFlg)
(PROCESSP (NC.NoteFileProp NoteFile (QUOTE ProcessInProgress))))
then (NC.PrintOperationInProgressMsg InterestedWindow (QUOTE Close% NoteFile)
(NC.NoteFileProp NoteFile (QUOTE
OperationInProgress))
)
(RETURN NIL))
(* * Do the rest under an operation in progress lock.)
(RETURN
(NC.ProtectedNoteFileOperation
NoteFile Close% NoteFile
(PROG NIL
(RESETSAVE NIL (BQUOTE (NC.ClearMsg , InterestedWindow T)))
(* * 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.)
(DEL.PROCESS (fetch (NoteFile CachingProcess) of NoteFile))
(* * See if any cards have operations in progress. If so, kill them after confirming with user.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T (OR OperationMsg "")
"Checking for card operations in progress ..."
(CHARACTER 13)))
(if (EQ (QUOTE ABORT)
(NC.CardOperationsInProgress NoteFile T))
then (RETURN NIL))
(NC.ClearMsg InterestedWindow NIL)
(* * If NULL QuietFlg then look for cards on the screen. If there are active cards ask the user if they still want
to close. When there's a non-NIL QuietFlg we just close the active cards.)
(if
(AND (NULL QuietFlg)
(for Window in (OPENWINDOWS)
thereis
(LET (Card)
(AND (SETQ Card
(OR (NC.CardFromWindow Window)
(AND (WINDOWP (WINDOWPROP
Window
(QUOTE ICONFOR)))
(NC.CardFromWindow
(WINDOWPROP Window
(QUOTE ICONFOR)))
)))
(NC.SameNoteFileP NoteFile (fetch
(Card NoteFile)
of Card)))))
(NULL (NC.AskYesOrNo (CONCAT
"There are still cards on the screen from this NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile)
"."
(CHARACTER 13)
"Want to close and save them? ")
" -- "
(QUOTE Yes)
NIL InterestedWindow NIL NIL)))
then (RETURN NIL))
(* * Run through CloseNoteFileFns with param of BEFORE. Exit if any returns DON'T)
(if (for Function in NC.CloseNoteFileFns
thereis (OR (EQ Function (QUOTE DON'T))
(EQ (QUOTE DON'T)
(APPLY* Function NoteFile (QUOTE BEFORE)
))))
then (RETURN NIL))
(* * Close all the active cards)
(OR QuietFlg (NC.PrintMsg InterestedWindow T (OR OperationMsg "")
"Checking for active cards ..."
(CHARACTER 13)))
(if (SETQ ActiveCards (NC.MapCards NoteFile (FUNCTION (LAMBDA (Card)
Card))
(FUNCTION NC.ActiveCardP)))
then
(if (NULL QuietFlg)
then (NC.PrintMsg InterestedWindow T
"Closing and saving active cards ... "))
(RESETLST
(RESETSAVE NC.ForceSourcesFlg NIL)
(RESETSAVE NC.ForceFilingFlg NIL)
(RESETSAVE NC.ForceTitlesFlg NIL)
(for Card in ActiveCards bind Window
do (for CardPart in (QUOTE (SUBSTANCE TOLINKS
GLOBALTOLINKS
PROPLIST))
do (OR (NC.ApplyFn ObtainWritePermissionFn Card
CardPart)
(until (NC.ApplyFn ObtainWritePermissionFn
Card CardPart)
do (OR QuietFlg
(NC.PrintMsg
InterestedWindow T
(CONCAT
"Waiting to obtain write permission for the "
CardPart
" on card "
(NC.FetchTitle
Card)
"...")))
(BLOCK)
finally (OR QuietFlg
(NC.PrintMsg
InterestedWindow NIL
"done.")))))
(NC.QuitCard Card T NIL T T InterestedWindow NIL QuietFlg)
(if (SETQ Window (NC.FetchWindow Card))
then (bind (Process ←(WINDOWPROP Window
(QUOTE PROCESS)
))
until (OR (NULL Process)
(PROCESS.FINISHEDP Process))
do (BLOCK)))))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "Done."
(CHARACTER 13))))
(* * Checkpoint the NoteFile.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Closing Notefile ... "
(CHARACTER 13)))
(if (NULL (CAR (ERSETQ (SETQ ReturnValue
(NC.CheckpointNoteFile NoteFile
QuietFlg T T T
InterestedWindow
OperationMsg)))))
then (SETQ ReturnValue (QUOTE CheckpointFailed)))
(* * Process error returns from in NC.CheckpointNoteFile)
(if (NOT (type? NoteFile ReturnValue))
then (if (NULL (ERSETQ (NC.ReportError
NIL
(CONCAT "Checkpoint of NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile)
" failed because "
ReturnValue "."
(CHARACTER 13)
"OK to continue Close. ↑ to abort Close."))))
then (RETURN ReturnValue)))
(* * Close the file.)
(if (NULL (CAR (ERSETQ (SETQ ReturnValue
(APPLY* (fetch (NoteFile
CloseNoteFileFn)
of NoteFile)
NoteFile InterestedWindow)))))
then (SETQ ReturnValue (QUOTE CloseFailed)))
(* * Process error returns from the close.)
(if (NOT (type? NoteFile ReturnValue))
then
(SELECTQ
ReturnValue
(NoteFileNotOpen
(if (NULL (ERSETQ (NC.ReportError
NIL
(CONCAT "NoteFile"
(fetch (NoteFile
FullFileName)
of NoteFile)
" is not open."
(CHARACTER 13)
"OK to continue Close. ↑ to abort Close."))))
then (RETURN ReturnValue)))
(PROGN (ERSETQ (NC.ReportError NIL
(CONCAT "Close of NoteFile "
(fetch
(NoteFile
FullFileName)
of NoteFile)
" failed because "
ReturnValue "."
(CHARACTER 13))))
(RETURN ReturnValue))))
(* * Run through CloseNoteFileFns with param of AFTER. Stop if any returns DON'T)
(for Function in NC.CloseNoteFileFns
thereis (EQ (QUOTE DON'T)
(APPLY* Function NoteFile (QUOTE AFTER))))
(* * Reset the interface and notify the user.)
(NC.ResetNoteFileInterface NoteFile)
(OR QuietFlg (NC.PrintMsg InterestedWindow T (fetch (NoteFile
FullFileName)
of NoteFile)
" closed."))
(* * * Cleanup a bit.)
(* Clean off the card cache's)
(ADD.PROCESS (LIST (FUNCTION NC.CleanupCardObjects)
(fetch (NoteFile HashArray) of NoteFile)))
(* Clean off the NoteFile object to remove any
circularities.)
(create NoteFile smashing NoteFile UID ←(fetch (NoteFile UID)
of NoteFile)
FullFileName ←(fetch (NoteFile
FullFileName)
of NoteFile)
Menu ←(fetch (NoteFile Menu) of NoteFile)
NoteFileDevice ←(fetch (NoteFile
NoteFileDevice)
of NoteFile))
(* * Return the NF)
(RETURN NoteFile))))))))
(NC.NoteFileOperations
(LAMBDA (NoteFile) (* fgh: " 1-Sep-86 13:34")
(* Ask usere to choose which database operation.
Called from main menu whenselected fn.)
(* * fgh 11/14/85 Updated to handle NoteFile object and per NoteFile menus.)
(* * kirk 14Jan86 Added Close/Delete cards and changed the format)
(* * fgh 6/13/86 Now sets BusyOperation of NF menu to something interesting.)
(* * kirk 3Jul86 passed NoteFileMenuWindow to NC.CompactNoteFile)
(* * fgh 7/5/86 Fixed above fix and put NoteFileMenuWindow is all calls.)
(* * rht 7/5/86: Added read-only open to notefileops menu.)
(* * kirk 7/14/86 Took comma out of FullFileName in NC.DeleteDatabaseFile call)
(* * kirk 15Jul86 Added Grey shade to non-functional items when file is open/closed)
(* * kef 8/6/86: Added SPAWN.MOUSE towards the end to eliminate the extraneous printing of "NoteFile Busy" which
seemed to be constantly occurring for remote NoteFiles.)
(LET ((NoteFileMenu (fetch (NoteFile Menu) of NoteFile))
(Font NC.MenuFont)
(FullFileName (fetch (NoteFile FullFileName) of NoteFile))
NoteFileMenuWindow Menu (OpenItems (QUOTE (Open Checkpoint Close Abort Compact Create)))
(CloseItems (QUOTE (Open Compact Inspect&Repair Copy Rename Delete Create))))
(SETQ NoteFileMenuWindow (WFROMMENU NoteFileMenu))
(OR (SETQ Menu (WINDOWPROP NoteFileMenuWindow (QUOTE DatabaseOperationsMenu)))
(WINDOWPROP NoteFileMenuWindow (QUOTE DatabaseOperationsMenu)
(SETQ Menu
(create MENU
ITEMS ←(BQUOTE ((Open (NC.OpenNoteFile , NoteFile ,
NC.NoteFilesHashArray NIL
NIL NIL NIL NIL
NIL NIL ,
NoteFileMenuWindow)
"Opens this NoteFile."
(SUBITEMS (Read-only% Open
(NC.OpenNoteFile
, NoteFile ,
NC.NoteFilesHashArray NIL
NIL NIL NIL NIL NIL
NIL ,
NoteFileMenuWindow NIL
NIL NIL NIL T)
"Opens this NoteFile for read-only.")))
(Checkpoint (NC.CheckpointNoteFile
, NoteFile NIL NIL NIL NIL ,
NoteFileMenuWindow)
"Checkpoint this NoteFile, saving changed cards.")
(Close (NC.CloseNoteFile , NoteFile ,
NoteFileMenuWindow)
"Closes this NoteFile.")
(Abort (NC.AbortSession , NoteFile ,
NoteFileMenuWindow)
"Close NF, deleteing changes since last checkpoint.")
(Compact (NC.CompactNoteFile , NoteFile
NIL NIL ,
NoteFileMenuWindow)
"Compacts a NoteFile to a target file."
(SUBITEMS (
Compact% To% Target% File (NC.CompactNoteFile , NoteFile NIL NIL , NoteFileMenuWindow)
"Compacts this NoteFile to a target file.")
(Compact% In% Place
(NC.CompactNoteFile
, NoteFile NIL T ,
NoteFileMenuWindow)
"Compacts this NoteFile in place.")))
(Inspect&Repair
(NC.InspectAndRepairNoteFile ,
NoteFile NIL
,
NoteFileMenuWindow)
"Inspects and optionally repairs this NoteFile."
(SUBITEMS (Read% Substances
(
NC.InspectAndRepairNoteFile
, NoteFile T ,
NoteFileMenuWindow)
"Inspects and optionally repairs a Notefile, but reads every substance. This slows it WAY down.")))
(Copy (NC.CopyNoteFile , NoteFile NIL ,
NoteFileMenuWindow)
"Copies this notefile to a target file.")
(Rename (NC.RenameNoteFile , NoteFile)
"Rename this NoteFile")
(Delete (NC.DeleteDatabaseFile ,
NoteFile ,
NoteFileMenuWindow)
"Deletes this NoteFile.")))
CHANGEOFFSETFLG ←(QUOTE Y)
MENUOFFSET ←(CONS -1 0)
CENTERFLG ← NIL
TITLE ← "NoteFile Ops"
MENUTITLEFONT ← Font
MENUFONT ← Font
ITEMHEIGHT ←(IPLUS (FONTPROP Font (QUOTE HEIGHT))
1)
WHENSELECTEDFN ←(FUNCTION (LAMBDA (Item Menu Button)
(WINDOWPROP (WFROMMENU (fetch (NoteFile Menu)
of (GETMENUPROP
Menu
(QUOTE NoteFile)))
)
(QUOTE BusyOperation)
(CAR Item))
(DEFAULTWHENSELECTEDFN Item Menu Button)))))))
(PUTMENUPROP Menu (QUOTE NoteFile)
NoteFile)
(* * grey shade non functional items)
(if (NC.NoteFileOpenP NoteFile)
then (if (NOT (GETMENUPROP Menu (QUOTE OpenFlg)))
then (PUTMENUPROP Menu (QUOTE OpenFlg)
T)
(for Item in (fetch (MENU ITEMS) of Menu)
do (SHADEITEM Item Menu (if (MEMB (CAR Item)
OpenItems)
then WHITESHADE
else GRAYSHADE)))
(replace (MENU IMAGE) of Menu with NIL))
else (if (GETMENUPROP Menu (QUOTE OpenFlg))
then (PUTMENUPROP Menu (QUOTE OpenFlg)
NIL)
(for Item in (fetch (MENU ITEMS) of Menu)
do (SHADEITEM Item Menu (if (MEMB (CAR Item)
CloseItems)
then WHITESHADE
else GRAYSHADE))
(replace (MENU IMAGE) of Menu with NIL))))
(SPAWN.MOUSE)
(MENU Menu))))
(NC.FileBrowserMenu
[LAMBDA (Window) (* Feuerman " 8-Aug-86 12:51")
(* * Bring up a notecards file browser after user selects pattern.)
(* * rht 7/2/86: Now calls NC.GetFileBrowserPattern. Also only stores file browser wins on the session icon
windowprop rather than both wins and patterns.)
(* * kef 8/8/86: Added kludge for constructing file browsers on remote Server.)
(LET (Menu Selection)
(SETQ Menu (create MENU
ITEMS ←[APPEND (UNION NC.FileBrowserPatterns
NC.FileBrowserDefaultPatterns)
(QUOTE ((---% New% Pattern% ---(QUOTE
New% Pattern)
"Make a new Notefile browser pattern."]
TITLE ← "Notefile Browser Pattern"))
(if (EQ (SETQ Selection (MENU Menu))
(QUOTE New% Pattern))
then (* User wants to give us a new pattern.)
(SETQ Selection (NC.GetFileBrowserPattern Window NIL)))
(if Selection
then (* See if browser for that pattern already exists,
else create one and stash on the NC icon's window's
proplist.)
(OR (NC.FlashFileBrowserWin Selection Window)
(LET ((FileBrowserWins (WINDOWPROP Window (QUOTE FileBrowserWins)))
(REMOTEHOSTP (NC.RemoteHostP Selection))
FileBrowserWin)
[SETQ FileBrowserWin (COND
[REMOTEHOSTP (FILEBROWSER (NCCLIENT.LISTNOTEFILES Selection)
(QUOTE NOTHING)
(BQUOTE (MENU.ITEMS ,
NC.FileBrowserMenuItems]
(T (FILEBROWSER Selection NIL (BQUOTE (MENU.ITEMS ,
NC.FileBrowserMenuItems]
(WINDOWPROP Window (QUOTE FileBrowserWins)
(CONS FileBrowserWin FileBrowserWins])
)
(* Changed functions from NCLINKS)
(DEFINEQ
(NC.ChangeLinkDisplayMode
(LAMBDA (LinkOrLinkIcon Window NewDisplayMode) (* fgh: "30-Aug-86 23:44")
(* * Change the display mode of the NOTECARDLINK defined by LinkOrLinkIcon. Have the user choose the new display
mode.)
(* * NOTE: assumes that the SourceID card of the link is active, i.e., the substance and links are cached for this
card.)
(* * rht 2/1/85: Now doesn't do all the work if new display mode is same as the old one. Or if user doesn't make a
selection from the menu.)
(* * kef 8/8/86: Now does the write through to the NoteFile even if the card is active, but not being edited.
Also, in the case of doing the write through, puts only the from links.)
(* * fgh 8/30/86 Adapted to call NC.IfCardPartNotBusy.)
(PROG (Card DestinationCard Link LinkIcon GlobalLinkFlg OldDisplayMode)
(COND
((NC.LinkIconImageObjP LinkOrLinkIcon)
(SETQ Link (NC.FetchLinkFromLinkIcon LinkOrLinkIcon))
(SETQ LinkIcon LinkOrLinkIcon))
(T (SETQ Link LinkOrLinkIcon)
(COND
((NOT (SETQ GlobalLinkFlg (NC.GlobalLinkP Link)))
(SETQ LinkIcon (NC.FetchLinkIconForLink Link))))))
(SETQ Card (fetch (Link SourceCard) of Link))
(SETQ OldDisplayMode (fetch (Link DisplayMode) of Link))
(COND
((WINDOWP Window))
((NC.ActiveCardP Card)
(SETQ Window (NC.FetchWindow Card))))
(* * Get new display mode from user)
(SETQ DestinationCard (fetch (Link DestinationCard) of Link))
(RETURN (NC.IfCardPartNotBusy
DestinationCard
(QUOTE FROMLINKS)
(PROG NIL
(if (NOT NewDisplayMode)
then (SETQ NewDisplayMode
(NC.DisplayModeFromStylesheetSelections
(STYLESHEET
(CREATE.STYLE (QUOTE ITEMS)
(LIST (create
MENU
ITEMS ←(QUOTE
(Yes No Float)))
(create
MENU
ITEMS ←(QUOTE
(Yes No Float)))
(create
MENU
ITEMS ←(QUOTE
(Yes No Float))))
(QUOTE ITEM.TITLES)
(QUOTE (Title?% LinkType?%
AttachBitmap?))
(QUOTE ITEM.TITLE.FONT)
(FONTCOPY MENUFONT (QUOTE WEIGHT)
(QUOTE BOLD))
(QUOTE SELECTIONS)
(
NC.StylesheetSelectionsFromDisplayMode
OldDisplayMode)
(QUOTE NEED.NOT.FILL.IN)
NIL
(QUOTE TITLE)
(QUOTE Display% Mode?)
(QUOTE POSITION)
(create POSITION
XCOORD ← LASTMOUSEX
YCOORD ← LASTMOUSEY))))))
(* * If new display mode is same as old, then bail out.)
(COND
((OR (NULL NewDisplayMode)
(EQUAL NewDisplayMode OldDisplayMode))
(RETURN NIL)))
(* * Update link in LinkIcon or in global links list)
(COND
(GlobalLinkFlg (for GlobalLink in (NC.FetchGlobalLinks Card)
when (NC.SameLinkP Link GlobalLink)
do (replace (Link DisplayMode) of
GlobalLink
with NewDisplayMode))
(NC.SetLinksDirtyFlg Card T))
(T (replace (Link DisplayMode) of (NC.FetchLinkFromLinkIcon
LinkIcon)
with NewDisplayMode)
(NC.MarkCardDirty Card)))
(* * Update link in ToLinks List of Source card)
(for ToLink in (NC.FetchToLinks Card) when (NC.SameLinkP
Link ToLink)
do (replace (Link DisplayMode) of ToLink with
NewDisplayMode))
(NC.SetLinksDirtyFlg Card T)
(* * Update Link in FromLinks list of Destination card)
(COND
((NC.CardBeingEditedP DestinationCard)
(for FromLink in (NC.FetchFromLinks DestinationCard)
when (NC.SameLinkP Link FromLink)
do (replace (Link DisplayMode) of FromLink with
NewDisplayMode))
(NC.SetLinksDirtyFlg DestinationCard T))
(T (WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile)
of DestinationCard))
(NC.GetLinks DestinationCard)
(for FromLink in (NC.FetchFromLinks
DestinationCard)
when (NC.SameLinkP Link FromLink)
do (replace (Link DisplayMode)
of FromLink with NewDisplayMode))
(NC.PutFromLinks DestinationCard)
(NC.DeactivateCard DestinationCard))))
(* * Update the image in any active window for Card)
(COND
((AND (WINDOWP Window)
(NOT (NC.TEditBasedP (NC.RetrieveType Card))))
(NC.UpdateLinkImages Window (fetch (Link DestinationCard)
of Link))))
(* This causes tedit to redisplay the screen.)
(RETURN (QUOTE CHANGED))))))))
(NC.RelabelLink
(LAMBDA (LinkOrLinkIcon Window NewLinkLabel ForceRedisplayFlg)
(* fgh: "30-Aug-86 23:52" pp pp)
(* Relabel a NoteCard link.
Ask user for new label. Update all the proper
references to this link.)
(* * rht 11/19/84: Fixed so that Card is defined before first use.)
(* * kirk 14Nov85: deleted use of and LinkID)
(* * kef 8/8/86: Added obtaining write lock and NC.PutFromLinks.)
(* * fgh 8/30/86 Adapted to NC.IfCardPartNotBusy)
(PROG (Link LinkIcon Card DestinationCard OldLabel NoteCardType GlobalLinkFlg)
(COND
((NC.LinkIconImageObjP LinkOrLinkIcon)
(SETQ Link (NC.FetchLinkFromLinkIcon LinkOrLinkIcon))
(SETQ LinkIcon LinkOrLinkIcon))
(T (SETQ Link LinkOrLinkIcon)
(COND
((NOT (SETQ GlobalLinkFlg (NC.GlobalLinkP Link)))
(SETQ LinkIcon (NC.FetchLinkIconForLink Link))))))
(SETQ Card (fetch (Link SourceCard) of Link))
(COND
((WINDOWP Window))
((NC.ActiveCardP Card)
(SETQ Window (NC.FetchWindow Card))))
(SETQ DestinationCard (fetch (Link DestinationCard) of Link))
(RETURN (NC.IfCardPartNotBusy DestinationCard (QUOTE FROMLINKS)
(PROG NIL
(COND
((NC.SystemLinkLabelP (fetch (Link Label)
of Link))
(NC.PrintMsg Window T
"This is a system maintained pointer."
(CHARACTER 13)
"You cannot change its label."
(CHARACTER 13))
(SPAWN.MOUSE)
(DISMISS 1500)
(NC.ClearMsg Window T))
((SETQ NewLinkLabel
(OR NewLinkLabel
(NC.AskLinkLabel Window NIL NIL T T)
))
(SETQ NoteCardType (NC.RetrieveType
Card))
(* * Put new label in Link Icon or global links list)
(COND
(GlobalLinkFlg (for GlobalLink
in (
NC.FetchGlobalLinks
Card)
when (NC.SameLinkP
GlobalLink Link)
do (replace
(Link Label)
of GlobalLink
with
NewLinkLabel)
(
NC.SetLinksDirtyFlg
Card T)
(RETURN)))
(T (replace (Link Label)
of (NC.FetchLinkFromLinkIcon
LinkIcon)
with NewLinkLabel)
(NC.MarkCardDirty Card)))
(* * Update ToLink list of the SourceCard card)
(for ToLink in (NC.FetchToLinks Card)
when (NC.SameLinkP ToLink Link)
do (replace (Link Label) of ToLink
with NewLinkLabel)
(NC.SetLinksDirtyFlg Card T)
(RETURN))
(* * Update FromLink list of DestinationCard card)
(COND
((NC.CardBeingEditedP DestinationCard)
(for FromLink in (NC.FetchFromLinks
DestinationCard)
when (NC.SameLinkP FromLink Link)
do (replace (Link Label)
of FromLink with
NewLinkLabel)
(NC.SetLinksDirtyFlg
DestinationCard T)
(RETURN)))
(T (WITH.MONITOR
(NC.FetchMonitor
(fetch (Card NoteFile)
of DestinationCard))
(NC.GetLinks DestinationCard)
(for FromLink in (
NC.FetchFromLinks
DestinationCard)
when (NC.SameLinkP FromLink
Link)
do (replace (Link Label)
of FromLink with
NewLinkLabel)
(NC.SetLinksDirtyFlg
DestinationCard T)
(RETURN))
(NC.PutFromLinks DestinationCard)
(NC.DeactivateCard DestinationCard)))
)
(* * Update images in SourceCard window)
(COND
((AND (NULL ForceRedisplayFlg)
(NC.TEditBasedP NoteCardType))
(RETURN (QUOTE CHANGED)))
((WINDOWP Window)
(NC.UpdateLinkImages
Window
(fetch (Link DestinationCard)
of Link))
(RETURN NIL))
(T (RETURN NIL)))))))))))
(NC.ChangeCardTitleFromLinkIcon
(LAMBDA (LinkIcon Window) (* fgh: "30-Aug-86 23:56")
(* * From a link icon sitting in Window, change the title of the link's destination card.)
(* * kirk 14Nov85: deleted use of PSA.Database)
(* * fgh 6/4/86 Fixed so that moves card back to original location if moved to be on screen.
This fixes a bug in TEdit that'll mess up the screen if a window is mived under a ImageObj ButtonEventInFn.)
(* * kef 7/16/86: Added mechanism for grabbing the write permission on the TITLE of the destination card.)
(* * 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.)
(* * fgh 8/30/86 Adpated to use NC.IfCardPartNotBusy.)
(LET (Link Card DestinationCard OldTitle NewTitle)
(RESETLST (RESETSAVE NIL (BQUOTE (MOVEW , Window , (LOWERLEFT (WINDOWPROP
Window
(QUOTE REGION))))
))
(if (NC.LinkIconImageObjP LinkIcon)
then (SETQ Link (NC.FetchLinkFromLinkIcon LinkIcon))
(SETQ Card (fetch (Link SourceCard) of Link))
(SETQ DestinationCard (fetch (Link DestinationCard) of Link))
(NC.IfCardPartNotBusy
DestinationCard
(QUOTE TITLE)
(if (SETQ NewTitle (NC.AskUser
(CONCAT "Enter new title for card with title '"
(NC.RetrieveTitle DestinationCard)
"'"
(CHARACTER 13))
"--> "
(if (AND (STREQUAL (SETQ OldTitle (
NC.RetrieveTitle
DestinationCard))
"Untitled")
(NC.FetchNewCardFlg DestinationCard))
then NIL
else OldTitle)
T Window))
then (NC.AssignTitle DestinationCard NIL NewTitle)
(QUOTE CHANGED))))))))
(NC.DeleteLink
(LAMBDA (Link NoOrphanHookFlg Don'tDelLinkIconFlg) (* fgh: "31-Aug-86 00:10")
(* * Delete a link with the option of not putting an orphan hook in case of last filing link.
Also option of not deleting link icon from the source card's substance.)
(* * fgh 5/2/86 Included calls to NC.DelReferencesToCardFromShowLinks in order to clean up ShowLinks windows when
links are deleted.)
(* * kef 7/17/86: Added the requirement that the write permissions be obtained for the TOLINKS of the Source Card
and the FROMLINKS of the Destination Card.)
(* * kef 7/22/86: Puts the links for the Destination Card now right away while we are still holding onto the write
lock for the FROMLINKS.)
(* * 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.)
(* * fgh 8/30/86 Adpated to use NC.IfCardPartNotBusy. Note use of ERROR!. Unfortunately, it appears that the only
way to keep TEDIT from deleting the Link's Image Object is to bail out but good. The control structure here works
because NC.IfCardPartNotBusy returns NIL if the CardPart is busy. The Ts at the end as the last SExpr in each call
to NC.IfCardPartNotBusy insure that NC.IfCardPartNotBusy returns non-NIL otherwise.)
(LET ((SourceCard (fetch (Link SourceCard) of Link))
(DestinationCard (fetch (Link DestinationCard) of Link))
BusyCardPart)
(WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of SourceCard))
(OR (NC.IfCardPartNotBusy DestinationCard (QUOTE FROMLINKS)
(OR (NC.IfCardPartNotBusy DestinationCard
(QUOTE TOLINKS)
(OR
Don'tDelLinkIconFlg
(
NC.DelReferencesToCard
SourceCard
Link))
(NC.DelFromLink
Link NoOrphanHookFlg)
(NC.DelToLink Link)
(
NC.DelReferencesToCardFromShowLinks
SourceCard Link)
(
NC.DelReferencesToCardFromShowLinks
DestinationCard Link)
(NC.PutFromLinks
DestinationCard)
(* * This UID replacement is worrisome. Does it mean that link deletion can't be undone?)
(replace
(Link UID)
of Link
with -1)
T)
(ERROR!))
T)
(ERROR!))))))
(NC.MakeLink
(LAMBDA (Window LinkLabel DestinationCard SourceCard DisplayMode AnchorMode Message NoDisplayFlg
LinkToInsertAfter) (* fgh: "31-Aug-86 00:18")
(* * Make a link from (OR Window SourceCard) to DestinationCard with linklabel of LinkLabel)
(* * rht 1/12/85: If need to create a new card, then now shows card type menu near window of SourceID.)
(* * rht 1/13/85: Added extra args Message and NoDisplayFlg.)
(* * rht 3/26/85: Added LinkToInsertAfter arg which should be NIL or a link to insert the new To link after.
If NIL, then insert at front of ToLinks.)
(* * kirk 9/23/85: took out GETPROMPTWINDOW call for asknotecardtype)
(* * kirk: 14Nov85: changed NC.CoerceToID to to NC.CoerceToCard)
(* * fgh 11/16/85 Changed from PROG to LET and used COND to contyrol returnmed value.)
(* * fgh 2/5/86 Changed call DefaultLinkDisplayMode to FetchLinkDisplayMode)
(* * fgh 6/5/86 Now calls AskLinkLabel if LinkLabel arg is NIL)
(* * rht 7/4/86: Added check for readonly card.)
(* * kef 7/17/86: Added calls to grab the write permission on the appropriate card parts.)
(* * kef 7/22/86: Saves the links on the Destination Card now right away, while still holding onto the FROMLINKS
write lock.)
(* * fgh 8/30/86 Adpated to use NC.IfCardPartNotBusy.)
(DECLARE (GLOBALVARS NC.SelectingSingleCardMenu))
(OR SourceCard (SETQ SourceCard (NC.CoerceToCard Window)))
(COND
((NC.CheckForNotReadOnly SourceCard Window "Can't make links in ")
(LET (Link Type)
(OR Window (SETQ Window (NC.FetchWindow SourceCard)))
(OR Message (SETQ Message "Please select the Card or Box to be linked to."))
(OR LinkLabel (SETQ LinkLabel (NC.AskLinkLabel Window NIL NIL T NIL)))
(OR DestinationCard (SETQ DestinationCard (NC.SelectNoteCards
T
(FUNCTION (LAMBDA (Card)
(COND
((NOT (NC.SameCardP Card SourceCard))
T)
(T (NC.PrintMsg Window T "A Card/Box cannot link to itself. "
(CHARACTER 13)
"Selection ignored."
(CHARACTER 13))
NIL))))
NC.SelectingSingleCardMenu SourceCard NIL Message)))
(COND
((EQ DestinationCard (QUOTE *New% Card*))
(SETQ DestinationCard (AND (SETQ Type (NC.AskNoteCardType (WINDOWREGION
Window)))
(NC.CoerceToCard (NC.MakeNoteCard
Type
(fetch (Card NoteFile)
of SourceCard)
NIL NoDisplayFlg))))))
(COND
(DestinationCard (NC.IfCardPartNotBusy DestinationCard (QUOTE FROMLINKS)
(NC.IfCardPartNotBusy
SourceCard
(QUOTE TOLINKS)
(SETQ Link (create Link
UID ←(NC.MakeUID)
SourceCard ←
SourceCard
DestinationCard ←
DestinationCard
AnchorMode ←
AnchorMode
Label ← LinkLabel
DisplayMode ←(OR
DisplayMode
(
NC.FetchLinkDisplayMode
SourceCard))))
(NC.AddToLink Link LinkToInsertAfter)
(NC.AddFromLink Link)
(* * Quick, before we lose the FROMLINKS write permission, put them out to the server.)
(AND (EQ (NC.FetchStatus
DestinationCard)
(QUOTE ACTIVE))
(NC.ActiveCardP DestinationCard)
(NC.PutFromLinks DestinationCard))
Link)))
(T NIL)))))))
(NC.AddFromLink
[LAMBDA (Link) (* Feuerman "22-Jul-86 15:31")
(* * Add Link to the FromLinks of the appropraite card on DatbaseStream)
(* * kirk: 14Nov85: deleted use of of DatabaseStream)
(* * rht 2/14/86: Now calls NC.UncacheLinks instead of two calls to NC.SetToLinks and NC.SetFromLinks.)
(* * kef 7/22/86: Now only calls NC.PutFromLinks instead of NC.PutLinks because we can't be certain of owning the
write locks on all of the Link parts.)
(LET ((Card (fetch (Link DestinationCard) of Link)))
[COND
((NC.ActiveCardP Card)
(NC.SetFromLinks Card (CONS Link (NC.FetchFromLinks Card)))
(NC.SetLinksDirtyFlg Card T))
(T (WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(NC.GetLinks Card)
(NC.SetFromLinks Card (CONS Link (NC.FetchFromLinks Card)))
(NC.SetLinksDirtyFlg Card T)
(NC.PutFromLinks Card)
(NC.UncacheLinks Card]
Link])
(NC.InsertLinkBeforeMarker
(LAMBDA (SourceCard DestinationCard LinkLabel DisplayMode Marker# NoSpacerFlg)
(* fgh: " 1-Sep-86 13:21")
(* Insert a link to DestinationCard in SourceCard just
before the Marker#'th place marker object)
(* * rht 12/7/84: Now returns the newly created link.)
(* * rht 9/13/85: When card is inactive, there won't be a current cursor position. So if no marker# is specified,
then insert at end.)
(* * kirk: 14Nov85: deleted use of of DatabaseStream)
(* * kef 7/28/86: Added call to obtain write locks on SUBSTANCE and all LINKS in the case when the card is not
NC.ActiveCardP.)
(* * kef 7/31/86: Added "balancing" of write lock ownership with NC.DeactivateCard.)
(* * kef 8/7/86: Now cached changes only occur if the card is currently being edited.)
(* * fgh 8/30/86 Adpated to NC.IfCardPartsNotBusy)
(* * fgh 9/1/86 Rescinded kef's change of 8/7/86. This causes active but nit visible cards to be written over even
if they are dirty.)
(LET (Objects TextStream TextObject (Spacer (CONCAT (CHARACTER 13)))
Link BusyPart)
(COND
((NC.ActiveCardP SourceCard)
(NC.IfMultipleCardPartsNotBusy SourceCard (SUBSTANCE TOLINKS FROMLINKS GLOBALTOLINKS)
(SETQ TextObject (TEXTOBJ (SETQ TextStream
(NC.FetchSubstance
SourceCard))))
(COND
((AND (FIXP Marker#)
(SETQ Objects (TEDIT.LIST.OF.OBJECTS
TextObject
(FUNCTION NC.PlaceMarkerP))))
(COND
((EQ Marker# 0)
(TEDIT.SETSEL TextStream 1 0 (QUOTE LEFT)))
((IGREATERP Marker# (FLENGTH Objects))
(TEDIT.SETSEL TextStream
(ADD1 (fetch (TEXTOBJ
TEXTLEN)
of TextObject))
0
(QUOTE RIGHT)))
(T (TEDIT.SETSEL TextStream
(CADAR (FNTH Objects Marker#)
)
0
(QUOTE LEFT)))))
(NC.MarkersInFileBoxesFlg (TEDIT.SETSEL TextStream
(GETEOFPTR
TextStream)
0
(QUOTE
RIGHT))))
(SETQ Link (NC.InsertLinkInText TextStream LinkLabel
DestinationCard
SourceCard
DisplayMode))
(COND
((NULL NoSpacerFlg)
(TEDIT.INSERT TextStream Spacer)))))
(T (WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of SourceCard))
(NC.IfMultipleCardPartsNotBusy
SourceCard
(SUBSTANCE TOLINKS FROMLINKS GLOBALTOLINKS)
(COND
((NC.CardP (NC.GetNoteCard SourceCard))
(* * This next set of obtain write locks is only to make sure that we come out even when NC.DeactivateCard releases
the write locks. Note that the SourceCard will be deactivated upon exit of the RESETLST, as set up by the
RESETSAVE.)
(RESETSAVE (for CardPart in (QUOTE (SUBSTANCE TOLINKS
GLOBALTOLINKS
PROPLIST))
do (APPLY* (fetch (Card
ObtainWritePermissionFn)
of SourceCard)
SourceCard CardPart))
(BQUOTE (NC.DeactivateCard , SourceCard)))
(SETQ TextObject (TEXTOBJ (SETQ TextStream (
NC.FetchSubstance SourceCard))))
(COND
((AND (FIXP Marker#)
(SETQ Objects (TEDIT.LIST.OF.OBJECTS
TextObject
(FUNCTION NC.PlaceMarkerP))))
(COND
((EQ Marker# 0)
(TEDIT.SETSEL TextStream 1 0 (QUOTE LEFT)))
((IGREATERP Marker# (FLENGTH Objects))
(TEDIT.SETSEL TextStream (ADD1 (fetch (TEXTOBJ
TEXTLEN)
of TextObject))
0
(QUOTE RIGHT)))
(T (TEDIT.SETSEL TextStream (CADAR (FNTH Objects
Marker#))
0
(QUOTE LEFT)))))
(T (* Cursor has no position in closed Tedit win, so just
set selection to end.)
(TEDIT.SETSEL TextStream (ADD1 (fetch (TEXTOBJ TEXTLEN)
of TextObject))
0
(QUOTE RIGHT))))
(SETQ Link (NC.InsertLinkInText TextStream LinkLabel
DestinationCard SourceCard
DisplayMode))
(COND
((NULL NoSpacerFlg)
(TEDIT.INSERT TextStream Spacer)))
(NC.PutMainCardData SourceCard)
(NC.PutLinks SourceCard)))))))
Link)))
(NC.InsertLinkInOrdering
(LAMBDA (SourceCard DestinationCard LinkLabel DisplayMode NoSpacerFlg OrderingFn)
(* fgh: " 1-Sep-86 13:23")
(* Insert a link to DestinationCard in SourceID.
Place to insert is dertermined alphabetically.)
(* * rht 6/14/85: Fixed the CHLIM uses according to Intermezzo changes. Also took out some SEL setting that was
useless. And changed TEDIT.SETSEL calls. Now uses OrderingFn arg so can do any sorts of orderings user wants.)
(* * kirk: 14Nov85: deleted use of of DatabaseStream and created Cached version)
(* * fgh 5/16/86 Replaced spuriois reference to Orphans card and replaced with correct reference to SourceCard.)
(* * kef 7/28/86: Added call to obtain write locks on SUBSTANCE and all links in the case when the card is not
NC.ActiveCardP.)
(* * kef 7/31/86: Added "balancing" of write lock ownership with NC.DeactivateCard.)
(* * kef 8/7/86: Now cached changes only occur if the card is currently being edited.)
(* * fgh 8/30/86 Adapted to NC.IfMultipleCardPartsNotBusy.)
(* * fgh 9/1/86 Rescinded kef's change of 8/7/86. Cached but not visible cards may be dirty and therefor should not
be reread from the NF.)
(if (NC.ActiveCardP SourceCard)
then (NC.IfMultipleCardPartsNotBusy SourceCard (SUBSTANCE TOLINKS FROMLINKS GLOBALTOLINKS)
(NC.CachedInsertLinkInOrdering SourceCard
DestinationCard
LinkLabel DisplayMode
NoSpacerFlg OrderingFn)
)
else (WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of SourceCard))
(NC.IfMultipleCardPartsNotBusy
SourceCard
(SUBSTANCE TOLINKS FROMLINKS GLOBALTOLINKS)
(if (NC.CardP (NC.GetNoteCard SourceCard))
then
(* * This next set of obtain write locks is only to make sure that we come out even when NC.DeactivateCard releases
the write locks. Note that the SourceCard will be deactivated upon exit of the RESETLST, as set up by the
RESETSAVE.)
(RESETSAVE (for CardPart
in (QUOTE (SUBSTANCE TOLINKS
GLOBALTOLINKS
PROPLIST))
do (APPLY* (fetch (Card
ObtainWritePermissionFn)
of SourceCard)
SourceCard CardPart))
(BQUOTE (NC.DeactivateCard , SourceCard)))
(NC.CachedInsertLinkInOrdering SourceCard DestinationCard
LinkLabel DisplayMode
NoSpacerFlg OrderingFn)
(NC.PutMainCardData SourceCard)
(NC.PutLinks SourceCard)))))))
(NC.HookToOrphanCard
(LAMBDA (Card OrphansCard) (* fgh: " 1-Sep-86 13:23")
(* The last reference to the card has just been
deleted. Hook this card to the orphan card so it
doesn't get lost forever)
(* * kirk: 14Nov85: deleted use of DatabaseStream and changed EQs to NC.Same*Ps)
(* * kef 7/29/86: Took out the calls to NC.PutMainCardData, NC.PutLinks, and NC.DeactivateCard after
NC.MakeFilingLink. The reason is that this is done within NC.InsertLinkBeforeMarker or NC.InsertLinkInOrdering,
which are called by NC.MakeFilingLink. Therefore, don't do this twice.)
(LET ((NoteFile (fetch (Card NoteFile) of Card)))
(OR OrphansCard (SETQ OrphansCard (fetch (NoteFile OrphansCard) of NoteFile)))
(COND
((NC.ActiveCardP OrphansCard)
(NC.MakeFilingLink OrphansCard Card (if (NC.FileBoxP Card T)
then NC.SubBoxLinkLabel
else NC.FiledCardLinkLabel)))
(T (WITH.MONITOR (NC.FetchMonitor NoteFile)
(NC.GetNoteCard OrphansCard) (* These no longer needed expressions used to go after
the NC.MakeFilingLink below:
(NC.PutMainCardData OrphansCard)
(NC.PutLinks OrphansCard) (NC.DeactivateCard
OrphansCard))
(NC.MakeFilingLink OrphansCard Card (if (NC.FileBoxP Card T)
then NC.SubBoxLinkLabel
else NC.FiledCardLinkLabel))))))
))
(NC.DelFromLink
[LAMBDA (Link NoOrphanHookFlg) (* Feuerman "30-Jul-86 15:00")
(* * Delete a FromLink from its destination card Hook card to orphan if this is the last link.)
(* * rht 11/15/84: Changed decision as to when to orphanize a card. Now must have deleted its last link
(not just last subbox or filedcard link). Also checks that link doesn't point from card to itself.)
(* * rht 12/1/84: Now doesn't do any work unless ID is valid, i.e. not DELETED or FREE.)
(* * kirk: 13Nov85: deleted of use of DatabaseStream and changed to call CachedDelFromLink.)
(* * kirk 29Jan86 Changed to a direct recursive call eliminating CachedDelFromLink. Added NC.FileInOrphanBox.)
(* * rht 2/14/86: Now calls NC.UncacheLinks instead of two calls to NC.SetToLinks and NC.SetFromLinks.)
(* * kef 7/30/86: Modified so that it only puts the FROMLINKS in the case of an inactiveP card.)
(LET ((DestinationCard (fetch (Link DestinationCard) of Link)))
(COND
((NC.ValidCardP DestinationCard)
(COND
((NC.ActiveCardP DestinationCard)
(NC.CachedDelFromLink Link DestinationCard)
(OR NoOrphanHookFlg (NC.FileInOrphanBox Link DestinationCard)))
(T (WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of DestinationCard))
(NC.GetLinks DestinationCard)
(NC.CachedDelFromLink Link DestinationCard)
(NC.PutFromLinks DestinationCard)
(OR NoOrphanHookFlg (NC.FileInOrphanBox Link DestinationCard))
(NC.UncacheLinks DestinationCard))
Link])
(NC.DelReferencesToCard
(LAMBDA (SourceCard LinkOrDestinationCard) (* fgh: "31-Aug-86 01:29")
(* The card specified by DestinationID is being
deleted. Remove all references to it from the card
specified by SourceCard)
(* * kirk: 13Nov85: deleted use of DatabaseStream)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * kef 7/31/86: Added wrapping of write lock grabbing so that deactivating the card preserves the nesting of
write lock ownership.)
(* * kef 8/5/86: Added putting of Main Card data in ActiveP case. This is so that if subsequent other people bring
up the card, they will see the fact that link card was deleted.)
(* * kef 8/7/86: Now requires that the card is being edited rather than just Active to thwart direct write through
to NoteFile.)
(* * rht 8/11/86 Added ShrunkenFlg so that SourceCard is reshrunk afterwards if necessary.)
(* * fgh 8/30/86 Changed APPLY* to NC.ApplyFn. Appears there might be trouble here since we don't appear to wait if
we can't get all the write permission locks. I am assuming for now that this is being taken care of at a higher
level.)
(LET ((ShrunkenFlg (NC.GetShrunkenWin SourceCard))
NoteCardType Substance)
(COND
((NC.CardBeingEditedP SourceCard)
(SETQ NoteCardType (NC.RetrieveType SourceCard))
(SETQ Substance (NC.FetchSubstance SourceCard))
(NC.ApplyFn DeleteLinksFn SourceCard LinkOrDestinationCard)
(NC.PutMainCardData SourceCard))
(T (WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of SourceCard))
(if (NC.ValidCardP (NC.GetNoteCard SourceCard))
then (RESETLST (RESETSAVE (for CardPart
in (QUOTE (SUBSTANCE TOLINKS
GLOBALTOLINKS
PROPLIST))
do (NC.ApplyFn
ObtainWritePermissionFn
SourceCard
CardPart))
(BQUOTE (NC.DeactivateCard ,
SourceCard)))
(SETQ NoteCardType (NC.RetrieveType SourceCard)
)
(SETQ Substance (NC.FetchSubstance SourceCard))
(NC.ApplyFn DeleteLinksFn SourceCard
LinkOrDestinationCard)
(NC.PutMainCardData SourceCard))))))
(NC.DelReferencesToCardFromGlobalList SourceCard LinkOrDestinationCard)
(AND ShrunkenFlg (SHRINKW (NC.FetchWindow SourceCard))))))
)
(* Changed functions from NCCOMPACT)
(DEFINEQ
(NC.CompactNoteFile
(LAMBDA (FromNoteFile ToFileName InPlaceFlg InterestedWindow)
(* fgh: " 1-Sep-86 19:27")
(* * Compact a NoteFile. If InPlaceFlg is T calls NC.CompactNoteFileInPlace. Otherwise if ToFileName is NIL, asks
for a new file name.)
(* * fkr 11/8/85 Updated to handle new CardID scheme and NoteFile object.)
(* * kirk 19Nov85: Created from NC.CompactDatabaseInPlace to handle new NoteFile format)
(* * fgh 5/186 Totally rewritten to get rid of numerous bugs. Added new InterestedWindow parameter.)
(* * rht 7/2/86: Fixed bug in call to NC.CompactToTarget and NC.CompactInPlace. They were being called with
FromNoteFile instead of (OR FromNoteFile FromFileName).)
(* * kirk 3Jul86 Added SETQ NC.DatabaseFileNameSuggestion)
(* * fgh 9/1/86 Now just a wrapper that calls the device specific compact fn. Old CompactNoteFile is now
NCLocalDevice.CompactNoteFile.)
(LET (FromFileName)
(* * Get the name of the file to be compacted)
(SETQ FromFileName (COND
((NULL FromNoteFile)
(PROG1 (NC.DatabaseFileName "Name of NoteFile to be compacted:" " -- " T NIL NIL
InterestedWindow)
(NC.ClearMsg InterestedWindow)))
((type? NoteFile FromNoteFile)
(fetch (NoteFile FullFileName) of FromNoteFile))
(T FromNoteFile)))
(* * Apply the device specific comnpact notefile fn for the file's host.)
(APPLY* (fetch (NoteFileDevice CompactNoteFileFn) of (NC.DeviceVectorForHost
(FILENAMEFIELD FromFileName
(QUOTE
HOST))
(QUOTE PRIVATE)))
FromFileName ToFileName InPlaceFlg InterestedWindow))))
)
(* Changed functions from NCREPAIR)
(DEFINEQ
(NC.InspectAndRepairNoteFile
(LAMBDA (NoteFileOrFileName ReadSubstancesFlg InterestedWindow)
(* fgh: " 1-Sep-86 19:36")
(* * Check to be sure file is closed before calling real inspect and repair.)
(* * rht 7/16/86: Added InterestedWindow arg. Removed call to NC.OpenDatabaseFile.)
(* * rht 7/17/86: Now works with file name args as well as notefile args. Took out reopen'ing of notefile, because
you don't know how it was originally opened.)
(* * fgh 9/1/86 Now just a wrapper for the device specific inspect & repair fn. Old functionality is in
NCLocalDevice.InspectAndRepairNoteFile.)
(LET (NoteFileName)
(* * Get the name of the file to be compacted)
(SETQ NoteFileName (COND
((NULL NoteFileOrFileName)
(PROG1 (NC.DatabaseFileName "Name of NoteFile to be compacted:" " -- " T NIL NIL
InterestedWindow)
(NC.ClearMsg InterestedWindow)))
((type? NoteFile NoteFileOrFileName)
(fetch (NoteFile FullFileName) of NoteFileOrFileName))
(T NoteFileOrFileName)))
(* * Apply the device specific repair notefile fn for the file's host.)
(APPLY* (fetch (NoteFileDevice RepairNoteFileFn) of (NC.DeviceVectorForHost
(FILENAMEFIELD NoteFileName
(QUOTE HOST))
(QUOTE PRIVATE)))
NoteFileOrFileName ReadSubstancesFlg InterestedWindow))))
)
(* * New for NCCARDS)
(DECLARE: EVAL@COMPILE
(DEFMACRO NC.WithWritePermission (CardForm CardPartForm &REST Body)
(* * Evaluate Body after obtaining WritePermission for the CardPart of a Card. Release
Write permission afterwards.)
(* * fgh 8/30/86 First created.)
(BQUOTE (RESETLST (RESETSAVE (NC.ApplyFn ObtainWritePermissionFn , CardForm , CardPartForm)
(BQUOTE (APPLY* , (fetch (Card ReleaseWritePermissionFn)
of , CardForm)
, , CardForm , (QUOTE , CardPartForm))))
,@ Body)))
(DEFMACRO NC.IfCardPartNotBusy (CardForm CardPartForm &REST Body)
(* * Do Body if can obtain write permission for CardPart of Card. Otherwise call
CardPartBusy.)
(* * fgh 8/30/86 First created.)
(BQUOTE (COND ((NOT (NC.ApplyFn ObtainWritePermissionFn , CardForm , CardPartForm))
(NC.CardPartBusy , CardForm , CardPartForm)
NIL)
(T (RESETLST (RESETSAVE NIL (BQUOTE (APPLY* , (fetch (Card
ReleaseWritePermissionFn)
of , CardForm)
, , CardForm , , CardPartForm)))
,@ Body)))))
(DEFMACRO NC.IfMultipleCardPartsNotBusy (CardForm CardPartsList &REST Body)
(* * Essentially call IfCardPartNotBusy for a whole bunch of CardParts)
(* * fgh 8/30/86 First created.)
(LET ((FormUnderConstruction (BQUOTE (PROGN ,@ Body))))
(for CardPart in (REVERSE CardPartsList)
do
(SETQ FormUnderConstruction (BQUOTE (NC.IfCardPartNotBusy , CardForm
(QUOTE , CardPart)
, FormUnderConstruction)
)))
FormUnderConstruction))
(DEFMACRO NC.DoCardPartFn (GetOrPut CardForm CardPartForm &REST Body)
(* * Call Get or Put card part fn both before and after Body.)
(* * fgh 8/31/86 First created.)
(BQUOTE (RESETLST (RESETSAVE (NC.ApplyFn , (PACK* GetOrPut (QUOTE CardPartFn))
, CardForm , CardPartForm (QUOTE BEFORE))
(BQUOTE (APPLY* , (fetch (Card , (PACK* GetOrPut (QUOTE
CardPartFn)))
of , CardForm)
, , CardForm , , CardPartForm AFTER)))
,@ Body)))
)
(FILESLOAD FILEBROWSERPATCH)
(* Miscellaneous patches)
(PUTPROPS FULLNAME READVICE (NIL (AROUND NIL (COND ((NC.RemoteHostP X)
(NCDEVICE.FULLNAME X))
(T *)))))
(READVISE FULLNAME)
(DEFINEQ
(NCDEVICE.FULLNAME
[LAMBDA (X RECOG) (* Feuerman " 8-Aug-86 15:37")
X])
)
(PUTPROPS NCDEVICEPATCH COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2642 37615 (NC.DatabaseFileName 2652 . 4472) (NC.DeleteDatabaseFile 4474 . 8753) (
NC.OpenDatabaseFile 8755 . 9528) (NC.CloseDatabaseFile 9530 . 9685) (NC.CheckpointDatabase 9687 .
11138) (NC.NoteFileOpenP 11140 . 11477) (NC.GetMainCardData 11479 . 14202) (NC.GetType 14204 . 16271)
(NC.GetTitle 16273 . 18612) (NC.GetLinks 18614 . 20557) (NC.GetPropList 20559 . 22520) (
NC.PutMainCardData 22522 . 26624) (NC.PutRegion 26626 . 27804) (NC.PutTitle 27806 . 30557) (
NC.PutLinks 30559 . 33598) (NC.PutPropList 33600 . 36478) (NC.GetNewCard 36480 . 37267) (
NC.ReadOnlyNoteFileP 37269 . 37613)) (40381 74806 (NC.QuitWithoutSaving 40391 . 47215) (
NC.DeactivateCard 47217 . 48535) (NC.MakeNoteCard 48537 . 51913) (NC.AssignTitle 51915 . 55686) (
NC.EditNoteCard 55688 . 58220) (NC.ClosePropListEditor 58222 . 61874) (NC.EditProperties 61876 . 63271
) (NC.CardSaveFn 63273 . 69656) (NC.DeleteNoteCard 69658 . 74804)) (91505 112855 (NC.CloseNoteFile
91515 . 104844) (NC.NoteFileOperations 104846 . 110866) (NC.FileBrowserMenu 110868 . 112853)) (112899
146815 (NC.ChangeLinkDisplayMode 112909 . 118285) (NC.RelabelLink 118287 . 123014) (
NC.ChangeCardTitleFromLinkIcon 123016 . 125104) (NC.DeleteLink 125106 . 127837) (NC.MakeLink 127839 .
131728) (NC.AddFromLink 131730 . 132850) (NC.InsertLinkBeforeMarker 132852 . 137844) (
NC.InsertLinkInOrdering 137846 . 140732) (NC.HookToOrphanCard 140734 . 142395) (NC.DelFromLink 142397
. 144116) (NC.DelReferencesToCard 144118 . 146813)) (146861 148800 (NC.CompactNoteFile 146871 .
148798)) (148845 150450 (NC.InspectAndRepairNoteFile 148855 . 150448)) (152749 152887 (
NCDEVICE.FULLNAME 152759 . 152885)))))
STOP