(FILECREATED "20-Aug-87 15:29:55" {QV}<NOTECARDS>1.3KNEXT>PMIPATCH058.;11 54194
changes to: (FNS NC.NoticedNoteFileNamesMenu)
(VARS PMIPATCH058COMS)
previous date: "18-Aug-87 12:37:50" {QV}<NOTECARDS>1.3KNEXT>PMIPATCH058.;7)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PMIPATCH058COMS)
(RPAQQ PMIPATCH058COMS ((DECLARE: FIRST (P (NC.LoadFileFromDirectories (QUOTE NCCOMPACT))))
(* * pmi 8/18/87: Changed menu of noticed notefiles to come up faster by
caching it whenever possible.)
(* * Changed in NCDATABASE)
(FNS NC.NoticedNoteFileNamesMenu NC.RemoveNoteFileName
NC.NoticeNoteFileName NC.AbortSession NC.CloseNoteFile
NC.CompactNoteFile)
(* * New for NCDATABASE)
(* * The function NC.CreateNoteFileMenuItems replaces NC.CreateMenuBitmaps
which should be removed.)
(FNS NC.CreateNoteFileMenuItems)
(GLOBALVARS NC.NoticedNoteFilesMenu NC.NoticedNoteFilesMenuNewItem)
(VARS (NC.NoticedNoteFilesMenu)
(NC.NoticedNoteFilesMenuNewItem))
(* * Changed in NCINTERFACE)
(FNS NC.DoNoteFileOp)
(* * Changed in NCCOMPACT)
(FNS NC.CompactNoteFileToTarget)))
(DECLARE: FIRST
(NC.LoadFileFromDirectories (QUOTE NCCOMPACT))
)
(* * pmi 8/18/87: Changed menu of noticed notefiles to come up faster by caching it whenever
possible.)
(* * Changed in NCDATABASE)
(DEFINEQ
(NC.NoticedNoteFileNamesMenu
(LAMBDA (IncludeNewNoteFileFlg AllowedOperations InterestedWindow Operation)
(* pmi: "20-Aug-87 15:27")
(* * Bring up a menu of all notefiles found in the notefiles hash array. Also allow user to open a new notefile.)
(* * kirk 23Jan86 Added AskYesOrNo and InterestedWindow parameter)
(* * fgh 6/8/86 Added check to make sure NoteFile is open if it has a menu on the screen. Needed to handle case of
liongering NF menus.)
(* * fgh 6/24/86 Changed to be a general function rather than one specific for opening. Now just returns the chosen
name. Also, added IncludeNewNoteFileFlg and ShowOnlyOpenNFsFlg. Removed InterestedWindow arg.)
(* * fgh 6/27/86 Added InterestedWindow & Operation args and call to NC.DatabaseFileName.)
(* * pmi 12/4/86: Added version numbers to rootnames on list of known files. Also cleaned up help string for menu
items. It was giving a bogus message about opening the selected file, even though this function is used for many
operations and not just for Open.)
(* * pmi 2/18/87: Added GLOBALVARS declaration for NC.MenuFont)
(* * pmi 5/15/87: Used to be NC.ListOfNoteFilesMenu. Changed symbol for open notefile to o.
Now uses NC.NoticedNoteFileNames instead of hash array to build menu. Returns a NoteFile name instead of a NoteFile
object.)
(* * pmi 5/21/87: Replaced each NoteFile menu item with a bitmap of its name in a large font and its full filename
in a small font.)
(* * pmi 8/20/87: Made modifications to speed up this menu: cache it when possible, only recompute the shading,
etc.)
(DECLARE (GLOBALVARS NC.FileNameFont NC.NoticedNoteFileNames NC.NoticedNoteFilesMenu
NC.NoticedNoteFilesMenuNewItem WHITESHADE GRAYSHADE))
(LET (Result)
(SETQ Result
(PROG (Items)
(if (NULL NC.NoticedNoteFilesMenu)
then (SETQ Items (BQUOTE
(,@(for NoteFileName in NC.NoticedNoteFileNames bind NoteFile
collect (SELECTQ (GETPROP NoteFileName (QUOTE
LastKnownStatus))
(OPEN (GETPROP NoteFileName
(QUOTE OpenMenuItem)))
(CLOSED (GETPROP NoteFileName
(QUOTE
ClosedMenuItem)))
NIL))
,@(if NC.NoticedNoteFilesMenuNewItem
then (LIST NC.NoticedNoteFilesMenuNewItem)
else (LIST (SETQ NC.NoticedNoteFilesMenuNewItem
(QUOTE ("-- Other NoteFile --"
(QUOTE NEW)
"Select some other notefile - you'll be prompted for the name.")))))
)))
(if (NULL Items)
then (SELECTQ AllowedOperations
(OPEN (NC.PrintMsg InterestedWindow NIL
"No open NoteFiles."
(CHARACTER 13)))
(CLOSED (NC.PrintMsg InterestedWindow NIL
"No closed NoteFiles."
(CHARACTER 13)))
(EITHER (NC.PrintMsg InterestedWindow NIL
"No NoteFiles."
(CHARACTER 13)))
(NC.PrintMsg InterestedWindow NIL
"No NoteFiles."
(CHARACTER 13)))
(RETURN NIL)
elseif (AND (EQ (LENGTH Items)
1)
(EQUAL (CADAR Items)
(QUOTE (QUOTE NEW))))
then (RETURN (QUOTE NEW))
else (SETQ NC.NoticedNoteFilesMenu
(create MENU
ITEMS ← Items
TITLE ← "NoteFiles"
MENUFONT ← NC.FileNameFont
ITEMHEIGHT ←(IPLUS (BITMAPHEIGHT (CAAR
Items))
1)))))
(* * Shade either the open or closed files, depending on the type allowed by this operation.)
(SELECTQ AllowedOperations
(OPEN (for NoteFileName in NC.NoticedNoteFileNames
do (SELECTQ (GETPROP NoteFileName (QUOTE
LastKnownStatus))
(OPEN (SHADEITEM (GETPROP NoteFileName
(QUOTE
OpenMenuItem))
NC.NoticedNoteFilesMenu
WHITESHADE))
(CLOSED (SHADEITEM (GETPROP NoteFileName
(QUOTE
ClosedMenuItem))
NC.NoticedNoteFilesMenu
GRAYSHADE))
(SHADEITEM (GETPROP NoteFileName
(QUOTE OpenMenuItem))
NC.NoticedNoteFilesMenu
WHITESHADE))))
(CLOSED (for NoteFileName in NC.NoticedNoteFileNames
do (SELECTQ (GETPROP NoteFileName (QUOTE
LastKnownStatus))
(OPEN (SHADEITEM (GETPROP NoteFileName
(QUOTE
OpenMenuItem)
)
NC.NoticedNoteFilesMenu
GRAYSHADE))
(CLOSED (SHADEITEM (GETPROP
NoteFileName
(QUOTE
ClosedMenuItem))
NC.NoticedNoteFilesMenu
WHITESHADE))
(SHADEITEM (GETPROP NoteFileName
(QUOTE
OpenMenuItem))
NC.NoticedNoteFilesMenu
WHITESHADE))))
(for NoteFileName in NC.NoticedNoteFileNames
do (SHADEITEM (GETPROP NoteFileName (QUOTE OpenMenuItem))
NC.NoticedNoteFilesMenu WHITESHADE)))
(* * Shade the new notefile item if a new notefile is allowed.)
(if IncludeNewNoteFileFlg
then (SHADEITEM NC.NoticedNoteFilesMenuNewItem NC.NoticedNoteFilesMenu
WHITESHADE)
else (SHADEITEM NC.NoticedNoteFilesMenuNewItem NC.NoticedNoteFilesMenu
GRAYSHADE))
(replace (MENU IMAGE) of NC.NoticedNoteFilesMenu with NIL)
(RETURN (MENU NC.NoticedNoteFilesMenu))))
(if (EQ Result (QUOTE NEW))
then (if IncludeNewNoteFileFlg
then (SETQ Result (NC.DatabaseFileName (CONCAT "Name of NoteFile to "
(SUBSTRING Operation
1 -9)
(CHARACTER 13))
" -- " T T NIL InterestedWindow))
else (NC.PrintMsg InterestedWindow T "Can't " Operation " a new notefile."
(CHARACTER 13))
(DISMISS 500)
(SETQ Result NIL)))
Result)))
(NC.RemoveNoteFileName
(LAMBDA (NoteFileOrFileName) (* pmi: "13-Aug-87 17:50")
(* * pmi 5/19/87: Created to keep track of noticed NoteFiles)
(* * pmi 8/13/87: Added trashing of NC.NoticedNoteFilesMenu to force its recomputation.)
(DECLARE (GLOBALVARS NC.NoticedNoteFileNames NC.NoticedNoteFilesMenu))
(LET (FullFileName)
(if (type? NoteFile NoteFileOrFileName)
then (SETQ FullFileName (fetch (NoteFile FullFileName) of NoteFileOrFileName))
else (SETQ FullFileName (OR (FULLNAME NoteFileOrFileName)
NoteFileOrFileName)))
(* * If the filename is a valid or invalid file, remove it from the list of noticed files. If the resulting list is
empty, set it to NIL (DREMOVE can't set a list to NIL))
(if (DREMOVE FullFileName NC.NoticedNoteFileNames)
else (SETQ NC.NoticedNoteFileNames NIL))
(* * Trash the menu of noticed notefiles so that it will be recomputed.)
(SETQ NC.NoticedNoteFilesMenu NIL))))
(NC.NoticeNoteFileName
(LAMBDA (NoteFileOrFileName) (* pmi: "13-Aug-87 18:35")
(* * pmi 5/14/87: Created to keep track of noticed NoteFiles)
(* * pmi 5/21/87: Now creates a menu item bitmap for this notefile.)
(* * pmi 8/13/87: Overhauled stuff for menu of noticed notefiles.)
(DECLARE (GLOBALVARS NC.NoticedNoteFileNames NC.NoticedNoteFilesMenu))
(LET (FullFileName NoteFile)
(if (type? NoteFile NoteFileOrFileName)
then (SETQ FullFileName (fetch (NoteFile FullFileName) of NoteFileOrFileName))
(SETQ NoteFile NoteFileOrFileName)
else (SETQ FullFileName (FULLNAME NoteFileOrFileName))
(SETQ NoteFile (NC.NoteFileFromFileName FullFileName)))
(* * If the filename is a valid file, add it to the list of noticed files. If the filename is not a valid file,
remove it from the list of noticed files. If the resulting list is empty, set it to NIL (DREMOVE can't set a list
to NIL))
(if FullFileName
then (if NC.NoticedNoteFileNames
then (MERGEINSERT FullFileName NC.NoticedNoteFileNames T)
else (SETQ NC.NoticedNoteFileNames (MERGEINSERT FullFileName
NC.NoticedNoteFileNames T)))
(SELECTQ (GETPROP FullFileName (QUOTE LastKnownStatus))
(OPEN (if (NULL (NC.NoteFileOpenP NoteFile))
then (PUTPROP FullFileName (QUOTE LastKnownStatus)
(QUOTE CLOSED))
(SETQ NC.NoticedNoteFilesMenu NIL)))
(CLOSED (if (NC.NoteFileOpenP NoteFile)
then (PUTPROP FullFileName (QUOTE LastKnownStatus)
(QUOTE OPEN))
(SETQ NC.NoticedNoteFilesMenu NIL)))
(PROGN (if (NC.NoteFileOpenP NoteFile)
then (PUTPROP FullFileName (QUOTE LastKnownStatus)
(QUOTE OPEN))
else (PUTPROP FullFileName (QUOTE LastKnownStatus)
(QUOTE CLOSED)))
(SETQ NC.NoticedNoteFilesMenu NIL)))
(* * Constuct menu items for this notefile.)
(NC.CreateNoteFileMenuItems FullFileName)
else (if (DREMOVE NoteFileOrFileName NC.NoticedNoteFileNames)
else (SETQ NC.NoticedNoteFileNames NIL))))))
(NC.AbortSession
(LAMBDA (NoteFile InterestedWindow Don'tConfirmFlg QuietFlg)
(* pmi: "18-Aug-87 12:34")
(* * Kill the current notecards session. Work lost since last checkpoint.)
(* * rht 7/14/85: Replaced the call to reset the main menu with call to NC.ResetMainMenu. Also took out redundant
reset of PSA.Database, since NC.ForceDatabaseClose is doing that.)
(* * fgh & rht 10/16/85 Update with new cacheing mechanism.)
(* * fkr 11/8/85 Updated to handle noteFile object and new CardID scheme.)
(* * kirk 20Jan86 Added Don'tCloseFlg to leave NoteFile open after done deleting changes.)
(* * kirk 23Jan86 Changed to use NC.AskYesOrNo)
(* * rht 7/2/86: No longer bugs you if no changes were made since last checkpoint. Removed Don'tCloseFlg arg and
added InterestedWindow arg.)
(* * rht 7/6/86: Now clears InterestedWindow of final truncating message.)
(* * rht 7/13/86: Added Don'tConfirmFlg and QuietFlg args. Note that Don'tConfirmFlg non-nil stops questioning of
user as to losing all changes.)
(* * kirk 11/17/86 Changed call on SETFILEINFO to pass stream instead of filename.)
(* * pmi 12/22/86 Made test for open notefile consistent with other NoteFile operations (ie. Checkpoint, Close))
(* * rht 2/19/87: Added DEL.PROCESS call to kill caching process.)
(* * rg 3/6/87 added NC.ProtectedSessionOperation wrapper)
(* * rht 3/25/87: Now calls NC.CoerceToInterestedWindow.)
(* * rg 3/31/87 changed ProtectedSessionOp to ProtectedNoteFileOp)
(* * pmi 8/7/87: Now asks for confirm no matter what work was done.)
(* * pmi 8/14/87: Now calls NC.NoticeNoteFile to make sure the file has been noticed.)
(* * pmi 8/18/87: No longer asks for confirm if notefile was open read-only.)
(DECLARE (GLOBALVARS NC.MsgDelay))
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow NoteFile)))
(NC.ProtectedNoteFileOperation
NoteFile "Abort Session" InterestedWindow
(PROG ((Stream (fetch (NoteFile Stream) of NoteFile))
(FullFileName (fetch (NoteFile FullFileName) of NoteFile))
(LastChkptPtr (fetch (NoteFile CheckptPtr) of NoteFile))
EndPtr CardTotal NewBytes ReturnValue)
(if (NULL (ERSETQ (SETQ ReturnValue (NC.NoteFileOpenP NoteFile))))
then (SETQ ReturnValue (QUOTE OpenPFailed)))
(if (NULL ReturnValue)
then
(* * NoteFile is not open.)
(NC.PrintMsg InterestedWindow T "Can't abort a closed notefile."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T)
(RETURN NIL)
elseif (NOT (type? NoteFile ReturnValue))
then
(* * Error return from NoteFileOpenPFn)
(if (NULL (ERSETQ (NC.ReportError NIL (CONCAT "OpenP test on "
FullFileName
"failed because "
ReturnValue
(CHARACTER 13)
"OK to continue Abort. ↑ to abort Abort."))))
then (RETURN ReturnValue)))
(* * Delete the types and titles caching process if still alive. Have to do it now in order to make checking
operations that follow suitably efficient. Note its a bit too early since we can still cancel this close.
But any harm done is loss of speed if NoteFile remains open when close iss cancelled.)
(DEL.PROCESS (fetch (NoteFile CachingProcess) of NoteFile))
(* * Removed old confirm question based on amount of stuff written past the checkpoint.)
(SETQ EndPtr (GETEOFPTR Stream))
(* * (SETQ NewBytes (IDIFFERENCE EndPtr LastChkptPtr)))
(* * This was in the if below: (OR (ZEROP NewBytes) Don'tConfirmFlg (NC.AskYesOrNo (CONCAT
"Do you wish to lose all changes since" (CHARACTER 13) "the last checkpoint (" NewBytes " bytes) of " FullFileName)
"--" "Yes" T InterestedWindow NIL T)))
(if (OR Don'tConfirmFlg (NC.ReadOnlyNoteFileP NoteFile)
(NC.AskYesOrNo (CONCAT "Do you wish to lose all changes since"
(CHARACTER 13)
"the open or last checkpoint of " FullFileName)
"--" "No" T InterestedWindow NIL T))
then (LET ((CardNumber 0)
(CardTotal (fetch (NoteFile HashArraySize) of NoteFile)))
(NC.MapCards NoteFile
(FUNCTION (LAMBDA (Card)
(LET (Win)
(SETQ CardNumber (ADD1 CardNumber))
(OR QuietFlg (COND
((ZEROP (IREMAINDER CardNumber 100))
(NC.PrintMsg InterestedWindow T
"Quitting from active cards ... "
(CHARACTER 13)
"Processing item number "
CardNumber " out of "
CardTotal "."
(CHARACTER 13)))))
(COND
((NC.ActiveCardP Card)
(SETQ Win (NC.FetchWindow Card))
(NC.AbortCard Card QuietFlg)
(COND
(Win (bind (Process ←(WINDOWPROP
Win
(QUOTE PROCESS)))
until (OR (NULL Process)
(PROCESS.FINISHEDP
Process))
do (BLOCK))
(CLOSEW Win))))))))))
(COND
((LESSP LastChkptPtr EndPtr)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Truncating file "
FullFileName " ..."))
(COND
((NOT (SETFILEINFO Stream (QUOTE LENGTH)
LastChkptPtr))
(NC.PrintMsg InterestedWindow NIL "Couldn't truncate "
FullFileName "." (CHARACTER 13))))))
(NC.ResetNoteFileInterface NoteFile)
(NC.ForceDatabaseClose NoteFile)
(NC.NoticeNoteFile NoteFile))
(NC.ClearMsg InterestedWindow T)))))
(NC.CloseNoteFile
(LAMBDA (NoteFile InterestedWindow QuietFlg AutoConfirmFlg)
(* pmi: "14-Aug-87 10:57")
(* * 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.)
(* * rpr 11/13/86: After closing active cards, checks to see if any special cards were made active and closes
them.))
(* * pmi 12/22/86 Made test for open notefile consistent with other NoteFile operations (ie. Abort Checkpoint,))
(* * rht 2/16/87: Added AutoConfirmFlg argument to prevent user having to confirm whether to close and save open
cards. Note that QuietFlg is stronger than AutoConfirmFlg in that other messages are suppressed as well.)
(* * rg 3/4/87 changes for new concurrency machinery)
(* * rht 3/25/87: Now calls NC.CoerceToInterestedWindow.)
(* * rg 3/27/87 redid concurrency wrapper)
(* * pmi 8/14/87: Added call to NC.NoticeNoteFile to make sure this file has been noticed. Also, added parameters
in call to NC.AbortSession to stop confirmation and pass on the QuietFlg.)
(DECLARE (GLOBALVARS NC.MsgDelay NC.CloseNoteFileFns))
(NC.ProtectedNoteFileOperation
NoteFile "Close NoteFile" InterestedWindow (OR (OPENWP InterestedWindow)
(SETQ InterestedWindow (
NC.CoerceToInterestedWindow NoteFile)))
(if (NC.ReadOnlyNoteFileP NoteFile)
then (NC.AbortSession NoteFile InterestedWindow T QuietFlg)
else
(ALLOW.BUTTON.EVENTS)
(PROG ((FullFileName (fetch (NoteFile FullFileName) of NoteFile))
CardTotal ActiveCards ReturnValue (OperationMsg ""))
(* * Make sure NF is open)
(if (NULL (ERSETQ (SETQ ReturnValue (NC.NoteFileOpenP NoteFile))))
then (SETQ ReturnValue (QUOTE OpenPFailed)))
(if (NULL ReturnValue)
then
(* * NoteFile is not open.)
(NC.PrintMsg InterestedWindow T "Can't close a closed notefile."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T)
(RETURN NIL)
elseif (NOT (type? NoteFile ReturnValue))
then
(* * Error return from NoteFileOpenPFn)
(if (NULL (ERSETQ (NC.ReportError NIL (CONCAT "OpenP test on "
FullFileName
"failed because "
ReturnValue
(CHARACTER
13)
"OK to continue Close. ↑ to abort Close."))))
then (RETURN ReturnValue)))
(RETURN
(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)
(NULL AutoConfirmFlg)
(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 "
FullFileName "." (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)
(NC.CloseListOfActiveCards ActiveCards
InterestedWindow
QuietFlg)
(NC.CloseListOfActiveCards (for Card
in (
NC.FetchSpecialCards
NoteFile)
when
(NC.ActiveCardP
Card)
collect Card)
InterestedWindow
QuietFlg))
(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
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 "
FullFileName
" 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" FullFileName
" is not open."
(CHARACTER 13)
"OK to continue Close. ↑ to abort Close."))))
then (RETURN ReturnValue)))
(PROGN (ERSETQ (NC.ReportError NIL
(CONCAT
"Close of NoteFile "
FullFileName
" 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, make sure the notefile has been noticed, and notify the user.)
(NC.ResetNoteFileInterface NoteFile)
(NC.NoticeNoteFile NoteFile)
(OR QuietFlg (NC.PrintMsg InterestedWindow T FullFileName " 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 Stream ← NIL UID ←(fetch
(NoteFile UID) of NoteFile)
FullFileName ← FullFileName Menu ←(fetch
(NoteFile Menu) of NoteFile)
NoteFileDevice ←(fetch (NoteFile
NoteFileDevice)
of NoteFile))
(* * Return the NF)
(RETURN NoteFile))))))))
(NC.CompactNoteFile
(LAMBDA (FromNoteFileOrName ToFileName InPlaceFlg InterestedWindow)
(* pmi: "13-Aug-87 19:00")
(* * 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.)
(* * pmi 12/19/86 Added test for open notefile so we can abort if it is open. Made consistent with other NoteFile
operations in the way it checks for valid NoteFile, gets msg window, etc.)
(* * pmi 5/29/87: Added call to NC.NoticeNoteFile to make sure this NoteFile is noticed. Cleaned up case where
notefilename is valid, but a notefile object does not exist. Now creates an interface menu for the target of
compaction if NC.NoteFileMenuLingerFlg is T. This menu for the new notefile is positioned slightly offset from the
original notefile's menu.)
(* * pmi 8/13/87: Moved call to NC.NoticeNoteFile for the new notefile (for compact to target) to this function
from NC.CompactNoteFileToTarget.)
(DECLARE (GLOBALVARS NC.MsgDelay NC.NoteFileMenuLingerFlg NC.NoteCardsIconWindow))
(PROG ((MsgWindow InterestedWindow)
FromNoteFile FromFileName FullFromFileName ReturnValue Menu MenuWindowRegion NewMenu)
(* * Get the name of the file to be compacted)
(if (type? NoteFile FromNoteFileOrName)
then (SETQ FromNoteFile FromNoteFileOrName)
(SETQ FromFileName (fetch (NoteFile FullFileName) of FromNoteFile))
elseif (SETQ FromFileName (OR FromNoteFileOrName
(NC.DatabaseFileName
"Name of NoteFile to be compacted:"
" -- " T NIL NIL MsgWindow)))
else (RETURN NIL))
(* * Check for existence of file to be compacted.)
(if (SETQ FullFromFileName (FULLNAME FromFileName))
then (if (OR FromNoteFile (SETQ FromNoteFile (NC.NoteFileFromFileName
FullFromFileName)))
then (SETQ MsgWindow (OR MsgWindow (NC.CoerceToInterestedWindow
FromNoteFile))))
else (NC.RemoveAccessToNoteFile FromFileName)
(SETQ MsgWindow (NC.CoerceToInterestedWindow MsgWindow))
(NC.PrintMsg MsgWindow T FromFileName " does not exist." (CHARACTER 13)
"Compact cancelled."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg MsgWindow T)
(RETURN NIL))
(* * Check to see if the notefile is open, abort if it is.)
(if (NC.NoteFileOpenP FromNoteFile)
then (NC.PrintMsg MsgWindow T "Can't compact an open notefile." (CHARACTER
13)
"Compact cancelled."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg MsgWindow T)
(RETURN NIL))
(* * Apply the device specific comnpact notefile fn for the file's host.)
(if (SETQ ReturnValue (APPLY* (fetch (NoteFileDevice CompactNoteFileFn)
of (NC.DeviceVectorForHost
(FILENAMEFIELD FullFromFileName
(QUOTE HOST))
(QUOTE PRIVATE)))
FullFromFileName ToFileName InPlaceFlg MsgWindow))
then
(* * Add the From notefile to the Hash Array and the list of noticed notefiles, in case it isn't already there.)
(NC.NoticeNoteFile FullFromFileName)
(if (NULL InPlaceFlg)
then
(* * Add the To notefile to the Hash Array and the list of noticed notefiles.)
(NC.NoticeNoteFile ReturnValue)
(if NC.NoteFileMenuLingerFlg
then (if (SETQ Menu (OR (AND (type? NoteFile FromNoteFile)
(fetch (NoteFile Menu)
of FromNoteFile))
(GETPROP FullFromFileName
(QUOTE Menu))))
then
(SETQ MenuWindowRegion (WINDOWPROP (WFROMMENU
Menu)
(QUOTE REGION)))
(SETQ NewMenu (NC.SetUpNoteFileInterface
ReturnValue
(create POSITION
XCOORD ←(fetch (REGION LEFT)
of MenuWindowRegion)
YCOORD ←(fetch (REGION BOTTOM)
of MenuWindowRegion))
MsgWindow))
(RELMOVEW
NewMenu
(create POSITION
XCOORD ← 6
YCOORD ←(MINUS
(PLUS (FONTHEIGHT (fetch
(MENU
MENUTITLEFONT)
of Menu))
6)))))))
else (NC.PrintMsg MsgWindow T "Compact cancelled." (CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg MsgWindow T))
(RETURN ReturnValue))))
)
(* * New for NCDATABASE)
(* * The function NC.CreateNoteFileMenuItems replaces NC.CreateMenuBitmaps which should be
removed.)
(DEFINEQ
(NC.CreateNoteFileMenuItems
(LAMBDA (FullFileName) (* pmi: "18-Aug-87 12:23")
(* * pmi 5/21/87: creates a menu item bitmap for this notefile.)
(* * pmi 8/18/87: Renamed from NC.CreateMenuBitmaps to construct the entire menu item instead of just the bitmap.
Also changed "o" (for open) to print in BOLD face.)
(DECLARE (GLOBALVARS NC.FileNameFont NC.FullFileNameFont NC.MaxFileNameChars))
(PROG (FileNameString FullFileNameString NameWidth MaxNameWidth SpaceWidth oWidth FullNameWidth
FullNameMargin FontDescent OpenMenuBitmap MenuBitmap DisplayStream
OpenDisplayStream (NC.BoldFullFileNameFont (FONTCOPY
NC.FullFileNameFont
(QUOTE WEIGHT)
(QUOTE BOLD))))
(if (OR (NULL FullFileName)
(AND (GETPROP FullFileName (QUOTE OpenMenuItem))
(GETPROP FullFileName (QUOTE ClosedMenuItem))))
then (RETURN))
(SETQ FileNameString (MKSTRING (PACKFILENAME (QUOTE HOST)
NIL
(QUOTE DIRECTORY)
NIL
(QUOTE EXTENSION)
NIL
(QUOTE BODY)
FullFileName)))
(SETQ FullFileNameString (MKSTRING (L-CASE FullFileName)))
(SETQ NameWidth (STRINGWIDTH FileNameString NC.FileNameFont))
(SETQ FullNameWidth (STRINGWIDTH FullFileNameString NC.FullFileNameFont))
(SETQ MaxNameWidth (STRINGWIDTH (ALLOCSTRING NC.MaxFileNameChars "X")
NC.FileNameFont))
(SETQ SpaceWidth (STRINGWIDTH " " NC.FullFileNameFont))
(SETQ oWidth (STRINGWIDTH "o" NC.BoldFullFileNameFont))
(if (GREATERP NameWidth MaxNameWidth)
then (SETQ FullNameMargin (PLUS SpaceWidth oWidth SpaceWidth NameWidth
SpaceWidth))
else (SETQ FullNameMargin (PLUS SpaceWidth oWidth SpaceWidth MaxNameWidth
SpaceWidth)))
(SETQ FontDescent (FONTDESCENT NC.FileNameFont))
(* * Create the bitmap for the open notefile.)
(SETQ OpenMenuBitmap (BITMAPCREATE (PLUS FullNameMargin FullNameWidth SpaceWidth)
(FONTHEIGHT NC.FileNameFont)))
(SETQ OpenDisplayStream (DSPCREATE OpenMenuBitmap))
(MOVETO SpaceWidth FontDescent OpenDisplayStream)
(DSPFONT NC.BoldFullFileNameFont OpenDisplayStream)
(PRIN1 "o" OpenDisplayStream)
(RELMOVETO SpaceWidth 0 OpenDisplayStream)
(DSPFONT NC.FileNameFont OpenDisplayStream)
(PRIN1 FileNameString OpenDisplayStream)
(MOVETO FullNameMargin FontDescent OpenDisplayStream)
(DSPFONT NC.FullFileNameFont OpenDisplayStream)
(PRIN1 FullFileNameString OpenDisplayStream)
(* * Construct the full menu item.)
(PUTPROP FullFileName (QUOTE OpenMenuItem)
(LIST OpenMenuBitmap (BQUOTE (QUOTE , FullFileName))
(CONCAT "Selects NoteFile " FullFileName)))
(* * Create bitmap for the closed notefile.)
(SETQ MenuBitmap (BITMAPCREATE (PLUS FullNameMargin FullNameWidth SpaceWidth)
(FONTHEIGHT NC.FileNameFont)))
(SETQ DisplayStream (DSPCREATE MenuBitmap))
(MOVETO (PLUS SpaceWidth oWidth SpaceWidth)
FontDescent DisplayStream)
(DSPFONT NC.FileNameFont DisplayStream)
(PRIN1 FileNameString DisplayStream)
(MOVETO FullNameMargin FontDescent DisplayStream)
(DSPFONT NC.FullFileNameFont DisplayStream)
(PRIN1 FullFileNameString DisplayStream)
(* * Construct the full menu item.)
(PUTPROP FullFileName (QUOTE ClosedMenuItem)
(LIST MenuBitmap (BQUOTE (QUOTE , FullFileName))
(CONCAT "Selects NoteFile " FullFileName)))
(RETURN FullFileName))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.NoticedNoteFilesMenu NC.NoticedNoteFilesMenuNewItem)
)
(RPAQQ NC.NoticedNoteFilesMenu NIL)
(RPAQQ NC.NoticedNoteFilesMenuNewItem NIL)
(* * Changed in NCINTERFACE)
(DEFINEQ
(NC.DoNoteFileOp
(LAMBDA (Op) (* pmi: "14-Aug-87 09:33")
(* * Do a NoteFile op chosen from NC icon menu)
(* * rht 7/2/86: Now calls NC.AbortSession with NC.NoteCardsIconWindow arg.)
(* * rht 7/5/86: Added Read-only% Open entry.)
(* * rht 7/17/86: Now calls NC.InspectAndRepairNoteFile instead of NC.ScavengerPhase1.)
(* * pmi 12/4/86: Added NC.NoteCardsIconWindow argument to calls to NC.ListOfNoteFilesMenu for "Delete" and
"Rename" operations)
(* * rht 2/11/87: Now handles case when Op has unexpected value.)
(* * rht 2/16/87: Added Close% w/o% confirm case.)
(* * pmi 5/15/87: overhauled to use NC.NoticedNoteFileNamesMenu instead of NC.ListOfNoteFilesMenu.
Added "Create and Open" and "Create and Read-only Open" options.)
(DECLARE (GLOBALVARS NC.NoteCardsIconWindow NC.MsgDelay))
(SELECTQ Op
(Open% NoteFile (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu T (QUOTE CLOSED)
NC.NoteCardsIconWindow
(QUOTE
Open% NoteFile))))
(if (NULL NoteFileName)
then NIL
else (if (EQ NoteFileName (QUOTE NEW))
then (SETQ NoteFileName NIL))
(NC.OpenDatabaseFile NoteFileName NIL NIL NIL NIL NIL
NIL NIL NIL NIL
NC.NoteCardsIconWindow))))
(Read-only% Open (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu T (QUOTE CLOSED)
NC.NoteCardsIconWindow
(QUOTE
Open% NoteFile))))
(if (NULL NoteFileName)
then NIL
else (if (EQ NoteFileName (QUOTE NEW))
then (SETQ NoteFileName NIL))
(NC.OpenDatabaseFile NoteFileName (QUOTE INPUT)
NIL NIL NIL NIL NIL NIL NIL NIL
NC.NoteCardsIconWindow))))
(Checkpoint% NoteFile (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu NIL
(QUOTE
OPEN)
NC.NoteCardsIconWindow
(QUOTE
Checkpoint% NoteFile))))
(if NoteFileName
then (NC.CheckpointDatabase (
NC.NoteFileFromFileName
NoteFileName)
NIL NIL
NC.NoteCardsIconWindow)
else (NC.PrintMsg NC.NoteCardsIconWindow NIL
"Checkpoint cancelled."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg NC.NoteCardsIconWindow T))))
(Close% NoteFile (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu NIL (QUOTE
OPEN)
NC.NoteCardsIconWindow
(QUOTE
Close% NoteFile))))
(if NoteFileName
then (NC.CloseNoteFile (NC.NoteFileFromFileName
NoteFileName)
NC.NoteCardsIconWindow)
else (NC.PrintMsg NC.NoteCardsIconWindow NIL
"Close cancelled."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg NC.NoteCardsIconWindow T))))
(Close% w/o% confirm (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu NIL
(QUOTE
OPEN)
NC.NoteCardsIconWindow
(QUOTE
Close% NoteFile))))
(if NoteFileName
then (NC.CloseNoteFile (NC.NoteFileFromFileName
NoteFileName)
NC.NoteCardsIconWindow NIL T)
else (NC.PrintMsg NC.NoteCardsIconWindow NIL
"Close w/o confirm cancelled."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg NC.NoteCardsIconWindow T))))
(Abort% NoteFile (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu NIL (QUOTE
OPEN)
NC.NoteCardsIconWindow
(QUOTE
Abort% NoteFile))))
(if NoteFileName
then (NC.AbortSession (NC.NoteFileFromFileName
NoteFileName)
NC.NoteCardsIconWindow)
else (NC.PrintMsg NC.NoteCardsIconWindow NIL
"Abort cancelled."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg NC.NoteCardsIconWindow T))))
(Compact% NoteFile (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu T (QUOTE
CLOSED)
NC.NoteCardsIconWindow
(QUOTE
Compact% NoteFile))))
(if (NULL NoteFileName)
then NIL
else (if (EQ NoteFileName (QUOTE NEW))
then (SETQ NoteFileName NIL))
(NC.CompactNoteFile NoteFileName NIL NIL NIL))))
(Compact% In% Place (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu T (QUOTE
CLOSED)
NC.NoteCardsIconWindow
(QUOTE
Compact% NoteFile))))
(if (NULL NoteFileName)
then NIL
else (if (EQ NoteFileName (QUOTE NEW))
then (SETQ NoteFileName NIL))
(NC.CompactNoteFile NoteFileName NIL T NIL))))
(Inspect&Repair% NoteFile (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu
T
(QUOTE CLOSED)
NC.NoteCardsIconWindow
(QUOTE Inspect&Repair% NoteFile))))
(if (NULL NoteFileName)
then NIL
else (if (EQ NoteFileName (QUOTE NEW))
then (SETQ NoteFileName NIL))
(NC.InspectAndRepairNoteFile NoteFileName
NIL
NC.NoteCardsIconWindow))))
(Read% Substances (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu T (QUOTE CLOSED)
NC.NoteCardsIconWindow
(QUOTE
Inspect&Repair% NoteFile))))
(if (NULL NoteFileName)
then NIL
else (if (EQ NoteFileName (QUOTE NEW))
then (SETQ NoteFileName NIL))
(NC.InspectAndRepairNoteFile NoteFileName T
NC.NoteCardsIconWindow))))
(Copy% NoteFile (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu T (QUOTE CLOSED)
NC.NoteCardsIconWindow
(QUOTE
Copy% NoteFile))))
(if (NULL NoteFileName)
then NIL
else (if (EQ NoteFileName (QUOTE NEW))
then (SETQ NoteFileName NIL))
(NC.CopyNoteFile NoteFileName NIL
NC.NoteCardsIconWindow))))
(Rename% NoteFile (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu T (QUOTE CLOSED)
NC.NoteCardsIconWindow
(QUOTE
Rename% NoteFile))))
(if (NULL NoteFileName)
then NIL
else (if (EQ NoteFileName (QUOTE NEW))
then (SETQ NoteFileName NIL))
(NC.RenameNoteFile NoteFileName NIL
NC.NoteCardsIconWindow))))
(Delete% NoteFile (LET ((NoteFileName (NC.NoticedNoteFileNamesMenu T (QUOTE CLOSED)
NC.NoteCardsIconWindow
(QUOTE
Delete% NoteFile))))
(if (NULL NoteFileName)
then NIL
else (if (EQ NoteFileName (QUOTE NEW))
then (SETQ NoteFileName NIL))
(NC.DeleteDatabaseFile NoteFileName
NC.NoteCardsIconWindow))))
(Create% NoteFile (NC.CreateDatabaseFile NIL NIL NIL NIL NIL NIL
NC.NoteCardsIconWindow NIL NIL NIL NIL NIL
NIL))
(Create% and% Open (NC.CreateDatabaseFile NIL NIL NIL NIL NIL NIL
NC.NoteCardsIconWindow NIL NIL T NIL NIL
NIL))
(LET ((NoteFileName (NC.NoticedNoteFileNamesMenu NIL (QUOTE EITHER)
NC.NoteCardsIconWindow)))
(if NoteFileName
then (APPLY* Op (NC.NoteFileFromFileName NoteFileName)
NC.NoteCardsIconWindow))))))
)
(* * Changed in NCCOMPACT)
(DEFINEQ
(NC.CompactNoteFileToTarget
(LAMBDA (FromNoteFile ToFileName InterestedWindow) (* pmi: "13-Aug-87 18:58")
(* * In sorted order, copy card parts to lower addresses in the file.)
(* * fgh 5/1/86 Now returns the ToNoteFile in order to be compatible with compact in place.)
(* * rht 11/3/86: Now opens FromNoteFile read-only. Also now takes InterestedWindow arg.)
(* * rht 1/22/87: Slight change to computation of new index size.)
(* * rht 3/17/87: Added RESETLST to make sure notefiles get closed in case of bombing out.)
(* * rht 5/15/87: No longer calls NC.ComputeNewDatabaseIndexSize. Target notefile's index will be same size as
source notefile's.)
(* * pmi 5/27/87: Removed HashArray argument in calls to NC.OpenNoteFile. Added call to NC.NoticeNoteFile to notice
the original and target notefiles. Also stopped creation of a notefile interface for the target notefile before
compaction -
it should be done at the end of compaction instead.)
(* * pmi 6/24/87: Now returns NIL if can't create the target notefile.)
(* * pmi 6/25/87: Now passes NIL for Can'tTruncateFlg in call to NC.OpenNoteFile.)
(* * pmi 8/13/87: Removed calls to NC.NoticeNoteFile; they are now done further up in NC.CompactNoteFile.)
(PROG (ToNoteFile OperationMsg)
(if (SETQ FromNoteFile
(NC.OpenNoteFile FromNoteFile T T T NIL NIL T T InterestedWindow NIL NIL NIL T))
then (SETQ OperationMsg (CONCAT "Compacting " (fetch (NoteFile FullFileName)
of FromNoteFile)
(CHARACTER 13)))
(SETQ ToNoteFile (NC.CreateDatabaseFile ToFileName (fetch (NoteFile
HashArraySize)
of FromNoteFile)
OperationMsg T NIL T
InterestedWindow NIL NIL NIL NIL T)
)
(if (EQ ToNoteFile (QUOTE CreateCancelled))
then (RETURN NIL)
else (SETQ ToNoteFile
(NC.OpenNoteFile ToNoteFile T T T T T T T InterestedWindow NIL
NIL NIL NIL NIL T)))
(RESETLST (RESETSAVE NIL (BQUOTE (NC.ForceDatabaseClose , FromNoteFile)
))
(RESETSAVE NIL (BQUOTE (NC.ForceDatabaseClose , ToNoteFile)))
(LET ((OriginalStream (fetch (NoteFile Stream) of FromNoteFile)
)
(TargetStream (fetch (NoteFile Stream) of ToNoteFile))
FromFileLength TargetFileLength BytesRecovered)
(replace (NoteFile NextIndexNum) of ToNoteFile
with (fetch (NoteFile NextIndexNum) of FromNoteFile))
(SETFILEPTR TargetStream (NC.TotalIndexSize
(fetch (NoteFile HashArraySize)
of ToNoteFile)))
(* truncate ToNoteFile after the index)
(if (NC.CopySortedCardParts (NC.SortIndexEntries
FromNoteFile)
ToNoteFile NIL NIL NIL
InterestedWindow OperationMsg)
then (* all useable card parts got copied)
(SETQ FromFileLength (GETEOFPTR OriginalStream)
)
(* * fool NC.PutHashArray into writing out the index for the new NoteFile)
(replace (NoteFile Stream) of FromNoteFile
with TargetStream)
(NCLocalDevice.PutHashArray FromNoteFile
InterestedWindow T
OperationMsg)
(replace (NoteFile Stream) of FromNoteFile
with OriginalStream)
(* * Put out the new ChkptPtr to the file.)
(replace (NoteFile CheckptPtr) of ToNoteFile
with (SETQ TargetFileLength (GETEOFPTR
TargetStream)))
(* * Steal the UID from the original file so links will work. Write out the header.)
(replace (NoteFile UID) of ToNoteFile
with (fetch (NoteFile UID) of
FromNoteFile))
(NC.PutNoteFileHeader ToNoteFile)
(SETQ BytesRecovered (DIFFERENCE
FromFileLength
TargetFileLength))
(NC.PrintMsg NIL T (fetch (NoteFile
FullFileName)
of FromNoteFile)
" compacted to "
(fetch (NoteFile FullFileName)
of ToNoteFile)
(CHARACTER 13)
"Recovered " BytesRecovered
" bytes ("
(FIX (TIMES 100
(FQUOTIENT
BytesRecovered
FromFileLength)))
"%%)"
(CHARACTER 13))
(NC.ClearMsg InterestedWindow T))))
(RETURN ToNoteFile)))))
)
(PUTPROPS PMIPATCH058 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1435 36299 (NC.NoticedNoteFileNamesMenu 1445 . 8115) (NC.RemoveNoteFileName 8117 . 9253
) (NC.NoticeNoteFileName 9255 . 11674) (NC.AbortSession 11676 . 17949) (NC.CloseNoteFile 17951 . 30646
) (NC.CompactNoteFile 30648 . 36297)) (36439 40461 (NC.CreateNoteFileMenuItems 36449 . 40459)) (40691
49144 (NC.DoNoteFileOp 40701 . 49142)) (49178 54112 (NC.CompactNoteFileToTarget 49188 . 54110)))))
STOP