(FILECREATED "25-Jun-87 14:19:17" {QV}<NOTECARDS>1.3K>NEXT>PMIPATCH048.;3 36137
changes to: (FNS NC.CompactNoteFileToTarget NC.CreateNoteFile)
(VARS PMIPATCH048COMS)
previous date: "24-Jun-87 17:54:47" {QV}<NOTECARDS>1.3K>NEXT>PMIPATCH048.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PMIPATCH048COMS)
(RPAQQ PMIPATCH048COMS ((* * pmi 6/24/87: Fixes bug #620: Compact to target defaults to wrong
version. It turns out that FULLNAME is buggy when you use if for file
server files, so I had to do some version checking more carefully.)
(DECLARE: FIRST (P (NC.LoadFileFromDirectories (QUOTE NCCOMPACT))))
(* * Changed in NCDATABASE)
(FNS NC.CreateNoteFile NC.OpenNoteFile)
(* * Changed in NCCOMPACT)
(FNS NC.CompactNoteFileToTarget)
(* * Changed in NCLOCALDEVICE)
(FNS NCLocalDevice.CompactNoteFile)))
(* * pmi 6/24/87: Fixes bug #620: Compact to target defaults to wrong version. It turns out
that FULLNAME is buggy when you use if for file server files, so I had to do some version
checking more carefully.)
(DECLARE: FIRST
(NC.LoadFileFromDirectories (QUOTE NCCOMPACT))
)
(* * Changed in NCDATABASE)
(DEFINEQ
(NC.CreateNoteFile
(LAMBDA (NoteFileOrFileName SizeInCards Don'tCreateSpecialCards InterestedWindow OperationMsg
QuietFlg PublicOrPrivate OpenFlg ReadOnlyFlg Don'tCreateInterfaceFlg
MenuPosition) (* pmi: "24-Jun-87 17:24")
(* * Create a NoteFile. Most of the work should be done by the device specific create notefile fn.)
(* * fgh 9/1/86 First created.)
(* * fgh&rht 9/5/86: Now creates small temporary hash array.)
(* * pmi 5/20/87: Added call to NC.SetUpNoteFileInterface to create a closed NoteFile Icon after creating the
NoteFile. Now asks if next version should be created if file already exists.)
(* * pmi 6/24/87: Had to strip version number from filename even when it doesn't exist, in case it came in with the
version number of a non-existent file.)
(DECLARE (GLOBALVARS NC.MsgDelay))
(PROG (NoteFile NoteFileName NoteFileFullName ReturnValue)
(* * Get the name from the user if necessary.)
(SETQ NoteFileName (if (type? NoteFile NoteFileOrFileName)
then (fetch (NoteFile FullFileName) of NoteFileOrFileName)
else (OR NoteFileOrFileName
(NC.DatabaseFileName
"What is the name of the file to be created?"
" -- " T T NIL
InterestedWindow))))
(if (NULL NoteFileName)
then (RETURN (QUOTE CreateCancelled)))
(* * Check to see if a file by this name already exists.)
(if (FILENAMEFIELD NoteFileName (QUOTE VERSION))
then
(* * A version has been specified -
make sure it does not already exist.)
(if (SETQ NoteFileFullName (FULLNAME NoteFileName (QUOTE OLD)))
then
(* * This file already exists as this version.)
(* * Notify user)
(NC.PrintMsg InterestedWindow T "NoteFile " NoteFileFullName
" already exists."
(CHARACTER 13))
(* * If the user wants to create the file, then create the next version of it.)
(SETQ NoteFileFullName (FULLNAME (PACKFILENAME (QUOTE
VERSION)
NIL
(QUOTE
BODY)
NoteFileFullName)
(QUOTE NEW)))
(if (NC.AskYesOrNo (CONCAT "Do you want to create "
NoteFileFullName
" (next available version)?")
" -- " "N" NIL InterestedWindow T NIL)
else (NC.PrintMsg InterestedWindow NIL "Create cancelled."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T)
(RETURN (QUOTE CreateCancelled)))
else
(* * This is already a valid new full file name; use it.)
(SETQ NoteFileFullName NoteFileName))
else
(* * No version specified, use the next available one.)
(SETQ NoteFileFullName (FULLNAME NoteFileName (QUOTE NEW))))
(* * Create a NoteFile object with a UID, etc.)
(SETQ NoteFile (if (type? NoteFile NoteFileOrFileName)
then NoteFileOrFileName
else (OR (NC.NoteFileFromFileName NoteFileFullName)
(create NoteFile))))
(replace (NoteFile UID) of NoteFile with (NC.MakeUID))
(replace (NoteFile MonitorLock) of NoteFile with (CREATE.MONITORLOCK
(QUOTE Creating% NoteFile)))
(replace (NoteFile FullFileName) of NoteFile with NoteFileFullName)
(replace (NoteFile ReadOnlyFlg) of NoteFile with NIL)
(* * only a small hash array for creating a file.)
(replace (NoteFile HashArray) of NoteFile
with (NC.CreateUIDHashArray (CONSTANT (LENGTH (RECORDFIELDNAMES
(QUOTE NoteFileCriticalUIDs))
))))
(* * Install the appropriate device vector)
(NC.InstallDeviceVectorInNoteFile NoteFile PublicOrPrivate)
(* * Say something to the user.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T (OR OperationMsg "")
"Creating NoteFile " NoteFileFullName ". Please wait... ")
)
(* * Call the device specific create notefile fn.)
(if (type? NoteFile (SETQ ReturnValue (CAR (ERSETQ (APPLY*
(fetch (NoteFile
CreateNoteFileFn)
of NoteFile)
NoteFile SizeInCards
InterestedWindow
OperationMsg QuietFlg)))))
then
(* * Device specific Create NoteFile fn returned okay. Go an an create the special cards.)
(if Don'tCreateSpecialCards
else (replace (NoteFile NextIndexNum) of NoteFile with 1)
(NC.InitializeSpecialCards NoteFile))
(* * Checkpoint the NF, then close it and return the NF objet.)
(NC.CheckpointNoteFile NoteFile QuietFlg T InterestedWindow OperationMsg)
(if (type? NoteFile (SETQ ReturnValue
(CAR (ERSETQ (APPLY* (fetch (NoteFile CloseNoteFileFn)
of NoteFile)
NoteFile SizeInCards
InterestedWindow OperationMsg
QuietFlg)))))
then (* Close went okay.)
(if (NULL QuietFlg)
then (NC.PrintMsg InterestedWindow NIL "Done!"
(CHARACTER 13))
(NC.ClearMsg InterestedWindow T))
(* Clean out the NF object and "notice it".)
(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))
(* * If needed, create a closed NoteFile interface.)
(if (AND (NULL Don'tCreateInterfaceFlg)
(NULL OpenFlg))
then (NC.SetUpNoteFileInterface NoteFile MenuPosition
InterestedWindow))
(* * Notice the notefile)
(NC.NoticeNoteFile NoteFile)
(* * Open the notefile, if requested)
(if OpenFlg
then (NC.OpenNoteFile NoteFile NIL T NIL NIL NIL
Don'tCreateInterfaceFlg NIL
InterestedWindow PublicOrPrivate
MenuPosition QuietFlg ReadOnlyFlg NIL
T))
(* Set the DatabaseFileNameSuggestion)
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME
(QUOTE VERSION)
NIL
(QUOTE BODY)
(fetch (NoteFile FullFileName) of NoteFile)))
(* Return the NoteFile.)
(RETURN NoteFile)
else (* Problems with closing the NoteFile -- error)
(NC.ReportError "NC.CreateNoteFile" (CONCAT
"Could not close notefile after it was created because: "
ReturnValue))
(RETURN ReturnValue))
else
(* * There was an error in the device specific create notefile fn.)
(NC.ReportError "NC.CreateNoteFile" (CONCAT
"Could not create NoteFile due to "
ReturnValue " error."))
(RETURN ReturnValue)))))
(NC.OpenNoteFile
(LAMBDA (NoteFileOrFileName Don'tCacheTypesAndTitlesFlg Don'tCreateFlg ConvertNoConfirmFlg
Don'tCreateArrayFlg Can'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg InterestedWindow PublicOrPrivate MenuPosition
QuietFlg ReadOnlyFlg Don'tCheckForTruncationFlg Don'tCheckVersionFlg)
(* pmi: "24-Jun-87 17:23")
(* * fgh 5/23/86 Renamed to NC.OpenNoteFile from NC.OpenDatabaseFile. Total revamp to implement device vector.)
(* * kef 7/18/86: Inserted a call to stuff the UID into the NoteFile because BuildHashArray needed it.)
(* * kef 7/21/86: Moved up the install of the NoteFile into the NoteFileHashArray to before the building of the
NoteFile's hash array. The reason is that the remote multi client build hash array function needs to get a list of
UIDs, and in order to do this, it needs to grab a Courier stream for the NoteFile given only the UID.
It can only do this if the UID is registered in the NoteFilesHashArray.)
(* * fgh 8/31/86 Updated to account for changes made to system since 5/23/86 revamp. Changes reimplemented include:
(fgh 6/8/86 Added code to insure that two files with SameUIDP would never be open at once.)
(fgh 6/25/86 Added contention locks -- NC.ProtectedNoteFileOperation, Don'tCheckOperationInProgressFlg etc.)
(fgh 6/27/86 Added MenuPsotion arg to pass to SetUpNoteFileInterface) (kirk 15Jul86 Added call to
NC.SetUpNoteFileInterface if already open))
(* * fgh 9/1/86 Reimplemented ReadOnly NoteFile open.)
(* * fgh 9/4/86 Put in default for NoteFilesHashArray which is NC.NoteFilesHashArray)
(* * kirk/rht 8/29/86: Now resets Name after conversion from version 2 to version3.)
(* * rht 10/29/86: Changed "aborted" to "canceled" in message.)
(* * rht 10/31/86: Added Don'tCheckForTruncationFlg arg.)
(* * rht&pmi 11/21/86: Took away the protection from around the AFTER call to open events fns.)
(* * pmi 12/12/86: Added InterestedWindow argument to NC.SetUpNoteFileInterface so that it can print a prompt to
the user about placing the NoteFile menu.)
(* * rg 3/4/87 Added NC.ProtectedSessionOperation wrapper, removed Don'tCheckOperationsInProgressFlg)
(* * rht 3/25/87: Now calls NC.CoerceToInterestedWindow.)
(* * pmi 3/31/87: Moved line of code which sets the ReadOnlyFlg to just after the test for an open notefile.
Otherwise, a notefile opened read-only could be changed to one opened normally.)
(* * rht 4/2/87: Now passes InterestedWindow to opennotefilefns.)
(* * rg 4/2/87 enlarged scope of NC.ProtectedNoteFileOperation)
(* * RG 4/3/87 replaced missing InterestedWindow arg to OpenNoteFileFn)
(* * pmi 5/19/87: Removed NoteFilesHashArray argument. Replaced call to NC.StoreNoteFileInHashArray with
NC.NoticeNoteFile in general cleanup.)
(* * pmi 5/20/87: Moved the open test up to almost the beginning of the function.)
(* * pmi 5/29/87: Deleted extra InterestedWindow argument to NC.ProtectedNoteFileOperation.
Added call to NC.RemoveAccessToNoteFile to "unnotice" this notefile if the file does not exist, and remove its
icon, if it has one. If InterestedWindow is the window for this NoteFile's interface, then change it to
NC.NoteCardsIconWindow.)
(* * pmi 6/3/87: Added check and warning for filenames which do not have the .notefile extension and which have not
yet been noticed (operated on) by NoteCards.)
(* * rht&pmi 6/4/87: Added TempInterestedWindow var to use until real InterestedWindow can be computed.)
(* * rht 6/8/87: Fixed what happens for notefiles with bad headers.)
(* * pmi 6/24/87: Added "(Highest version)" to question about opening highest version of a file.
Added Don'tCheckVersionFlg for Create and Compact, which have already figured out the correct version.)
(DECLARE (GLOBALVARS NC.OpenNoteFileFns NC.LastNoteFileOpened))
(* * NOTE: Session lock turns into NoteFile lock after NoteFile is created)
(PROG ((TempInterestedWindow (OR InterestedWindow (NC.CoerceToInterestedWindow
NoteFileOrFileName)))
NoteFile FileName NewerFileName OldVersion NewVersion NoteFileMenu ReturnValue
CriticalUIDs)
(* * Figure out the name of the file containing the NoteFile)
(if (NULL (SETQ FileName (if (type? NoteFile NoteFileOrFileName)
then (fetch (NoteFile FullFileName) of
NoteFileOrFileName)
elseif NoteFileOrFileName
else (NC.DatabaseFileName
"Name of NoteFile to open:"
" -- " T NIL NIL
TempInterestedWindow))))
then (RETURN NIL))
(* * Check for the .NoteFile extension if this notefile has not been noticed by NoteCards.)
(if (AND (NEQ (U-CASE (FILENAMEFIELD FileName (QUOTE EXTENSION)))
(QUOTE NOTEFILE))
(NOT (NC.NoteFileNoticedP FileName)))
then (NC.PrintMsg InterestedWindow T FileName
" does not have a .NOTEFILE extension."
(CHARACTER 13))
(if (NULL (NC.AskYesOrNo (CONCAT "Are you sure you want to open "
FileName " as a NoteFile?")
" -- " "No" NIL InterestedWindow T NIL))
then (NC.ClearMsg InterestedWindow T)
(RETURN NIL)))
(* * If this is an open NoteFIle, just bring up its menu.)
(if (NC.NoteFileOpenP FileName)
then (OR Don'tCreateInterfaceFlg (NC.SetUpNoteFileInterface (
NC.NoteFileFromFileName
FileName)
MenuPosition
TempInterestedWindow))
(NC.ClearMsg TempInterestedWindow T)
(* bring up or create notefile icon if needed)
(RETURN NIL))
(* * Check for higher version of same notefile)
(if (AND (NOT Don'tCheckVersionFlg)
(SETQ OldVersion (FILENAMEFIELD FileName (QUOTE VERSION)))
(SETQ NewVersion (FILENAMEFIELD (SETQ NewerFileName
(FULLNAME (PACKFILENAME
(QUOTE VERSION)
NIL
(QUOTE BODY)
FileName)))
(QUOTE VERSION)))
(LESSP OldVersion NewVersion))
then
(* * Notify user)
(NC.PrintMsg TempInterestedWindow T "A higher version of " FileName
" exists."
(CHARACTER 13))
(* * Open the version the user requests.)
(if (NC.AskYesOrNo (CONCAT "Open " NewerFileName
" instead? (Highest version)")
" -- " "No" NIL TempInterestedWindow T NIL)
then (SETQ FileName NewerFileName)
(SETQ NoteFileOrFileName (NC.NoteFileFromFileName FileName))
(if (SETQ NoteFileMenu (NC.GetNoteFileMenu FileName))
then (NC.SetNoteFileMenu NoteFileOrFileName NoteFileMenu))))
(* * Create a NoteFile object or use existing notefile object if there is one for this file name.)
(SETQ NoteFile (if (type? NoteFile NoteFileOrFileName)
then NoteFileOrFileName
else (OR (NC.NoteFileFromFileName FileName)
(create NoteFile))))
(replace (NoteFile FullFileName) of NoteFile with FileName)
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow NoteFile)))
(RETURN
(NC.ProtectedNoteFileOperation
NoteFile "Open NoteFile" InterestedWindow
(PROG NIL
(* * Figure out the appropriate device vector from the file name.)
(NC.InstallDeviceVectorInNoteFile NoteFile PublicOrPrivate)
(* * Moved this replace to after test for open notefile. Otherwise, if notefile is open read-only, it well be
changed to regular open.)
(replace (NoteFile ReadOnlyFlg) of NoteFile with ReadOnlyFlg)
(* * Notify user.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Opening NoteFile: "
FileName " ..." (CHARACTER 13)))
(SETQ ReturnValue
(PROG NIL
(* * Run through OpenNoteFileFns with param of BEFORE. Exit if any returns DON'T)
(if (for Function in NC.OpenNoteFileFns
thereis (OR (EQ Function (QUOTE DON'T))
(EQ (QUOTE DON'T)
(APPLY* Function FileName NoteFile
(QUOTE BEFORE)
InterestedWindow))))
then (if (WINDOWP InterestedWindow)
then (NC.PrintMsg InterestedWindow NIL
"Open canceled for NoteFile "
FileName "." (CHARACTER
13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T))
(RETURN))
(* * Call the device specific OpenNoteFileFn, which returns a list of special UIDs)
(if (NULL (ERSETQ (SETQ ReturnValue
(APPLY* (fetch (NoteFile
OpenNoteFileFn)
of NoteFile)
NoteFile InterestedWindow
Don'tCheckForTruncationFlg))))
then (SETQ ReturnValue (QUOTE NoteFileOpenFailed)))
(* * Process error returns from the OpenNoteFileFn)
(if (NOT (LITATOM ReturnValue))
then
(* * OpenNoteFileFn returned correctly)
(SETQ CriticalUIDs ReturnValue)
else
(* * Error, process it.)
(SETQ ReturnValue
(OR (SELECTQ
ReturnValue
(NoteFileNotFound (NC.RemoveAccessToNoteFile
NoteFile)
(SETQ InterestedWindow
(NC.CoerceToInterestedWindow
InterestedWindow))
(NC.ProcessNoteFileNotFoundError
NoteFile
Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg ConvertNoConfirmFlg
Don'tCreateArrayFlg
Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg
InterestedWindow PublicOrPrivate
MenuPosition QuietFlg ReadOnlyFlg
Don'tCheckForTruncationFlg))
(NoteFileNeedsConversion (
NC.ProcessNoteFileNeedsConversionError
NoteFile
Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg
ConvertNoConfirmFlg
Don'tCreateArrayFlg
Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg
InterestedWindow
PublicOrPrivate
MenuPosition QuietFlg
ReadOnlyFlg
Don'tCheckForTruncationFlg))
(NoteFileNeedsTruncation (
NC.ProcessNoteFileNeedsTruncationError
NoteFile
Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg
ConvertNoConfirmFlg
Don'tCreateArrayFlg
Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg
InterestedWindow
PublicOrPrivate
MenuPosition QuietFlg
ReadOnlyFlg
Don'tCheckForTruncationFlg))
(NoteFileAlreadyOpen
(ERSETQ (NC.ReportError
NIL
(CONCAT (fetch (NoteFile
FullFileName)
of NoteFile)
" is already open for exclusive access. Open failed."))))
(NoteFileOpenFailed
(ERSETQ (NC.ReportError
NIL
(CONCAT "Open of "
(fetch (NoteFile
FullFileName)
of NoteFile)
" failed for unknown reason."))
))
((NoteFileHeaderBad BadNextIndexNum BadHashArraySize
BadCheckptPtr BadNextLinkNum)
(ERSETQ (NC.ReportError
NIL
(CONCAT "Header of NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile)
" is bad: " ReturnValue
". Contact a NoteCards wizard."))))
(PROGN (ERSETQ (NC.ReportError NIL
(CONCAT
"Unknown error code ("
ReturnValue
") returned by OpenNoteFileFn for NoteFile "
FileName)))))
ReturnValue))
(* * notify the user. if there's been a problem)
(if (AND (NOT (type? NoteFile ReturnValue))
(WINDOWP InterestedWindow))
then (NC.PrintMsg InterestedWindow NIL
"Open canceled for NoteFile "
FileName "." (CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T))
(* * return whatever the error processing returned.)
(RETURN ReturnValue))
(SETQ ReturnValue)
(* * Make sure there is no other open NF with this UID.)
(LET (NF)
(if (AND (SETQ NF (GETHASH (fetch (
NoteFileCriticalUIDs NoteFile) of CriticalUIDs)
NC.NoteFilesHashArray))
(NEQ (fetch (NoteFile FullFileName)
of NoteFile)
(fetch (NoteFile FullFileName)
of NF))
(NC.NoteFileOpenP NF))
then (FLASHW PROMPTWINDOW)
(NC.PrintMsg PROMPTWINDOW T "Couldn't open "
FileName (CHARACTER 13)
"because "
(fetch (NoteFile FullFileName)
of NF)
" is already open "
(CHARACTER 13)
"and has the same UID.")
(NC.CloseNoteFile NoteFile InterestedWindow T)
(RETURN NIL)))
(* * If needed, build a hash array by calling the device specific BuilHashArrayFn.)
(replace (NoteFile UID) of NoteFile with (fetch
(
NoteFileCriticalUIDs NoteFile) of CriticalUIDs))
(* * Store this NoteFile object in the appropriate NoteFile hash array)
(NC.NoticeNoteFile NoteFile)
(if (NOT Don'tCreateArrayFlg)
then
(OR QuietFlg (NC.PrintMsg InterestedWindow T
"Opening NoteFile: "
FileName
(CHARACTER 13)
"Building index array ..."
(CHARACTER 13)))
(if
(OR (NULL (ERSETQ (SETQ ReturnValue
(APPLY*
(fetch (NoteFile
BuildHashArrayFn)
of NoteFile)
NoteFile QuietFlg
InterestedWindow
(CONCAT "Opening NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile)
(CHARACTER 13))))))
(NOT (type? NoteFile ReturnValue)))
then
(* * Error during building of hash array)
(ERSETQ (NC.ReportError
NIL
(CONCAT
"Build Hash Array failed for NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile)
" because " ReturnValue)))
(RETURN)))
(* * Set up critical UIDs in NoteFile object using the values returned from OpenNoteFileFn.)
(NC.InstallCriticalUIDsInNoteFile NoteFile CriticalUIDs)
(* * if needed, cache the special cards)
(if (NOT Don'tGetSpecialCardsFlg)
then (NC.GetSpecialCards NoteFile QuietFlg InterestedWindow
(CONCAT "Opening NoteFile: "
(fetch (NoteFile
FullFileName)
of NoteFile)
(CHARACTER 13))))
(* * If needed, start the titles and types caching process)
(if (NOT Don'tCacheTypesAndTitlesFlg)
then (replace (NoteFile CachingProcess) of NoteFile
with (ADD.PROCESS (LIST (FUNCTION
NC.CacheTypesAndTitles)
NoteFile))))
(* * If needed, open up a NoteFile interface.)
(if (NOT Don'tCreateInterfaceFlg)
then (NC.SetUpNoteFileInterface NoteFile MenuPosition
InterestedWindow))
(* * Record this as the last NF opened.)
(SETQ NC.LastNoteFileOpened NoteFile)
(RETURN NoteFile)))
(if (type? NoteFile ReturnValue)
then
(* * Run through OpenNoteFIleFns with param of AFTER. Stop if any returns DON'T)
(for Function in NC.OpenNoteFileFns
thereis (EQ (QUOTE DON'T)
(APPLY* Function FileName NoteFile
(QUOTE AFTER)
InterestedWindow)))
(* * Go home, returning NoteFile)
(if (NULL QuietFlg)
then (NC.PrintMsg InterestedWindow T "Opening NoteFile: "
FileName (CHARACTER 13)
"Done."
(CHARACTER 13))
(NC.ClearMsg InterestedWindow T))
(RETURN NoteFile)
else
(* * Bail out if open was unsuccessful.)
(RETURN NIL))))))))
)
(* * Changed in NCCOMPACT)
(DEFINEQ
(NC.CompactNoteFileToTarget
(LAMBDA (FromNoteFile ToFileName InterestedWindow) (* pmi: "25-Jun-87 13:13")
(* * 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.)
(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))
(* * Notice the original notefile and the new target notefile)
(NC.NoticeNoteFile FromNoteFile)
(NC.NoticeNoteFile ToNoteFile)
(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)))))
)
(* * Changed in NCLOCALDEVICE)
(DEFINEQ
(NCLocalDevice.CompactNoteFile
(LAMBDA (FromNoteFile ToFileName InPlaceFlg PromptWindow)
(* pmi: "24-Jun-87 16:50")
(* * 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 PromptWindow 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)
(* * rht 10/16/86: Now autoloads NCREPAIR.)
(* * rht 11/3/86: No longer reopens if was originally open. Also now passes PromptWindow along to called
functions.)
(* * pmi 5/27/87: Now returns the target notefile.)
(* * pmi 6/24/87: No longer tries to calculate full file name for target file -
let create notefile worry about that later.)
(DECLARE (GLOBALVARS NC.DatabaseFileNameSuggestion))
(LET (FromFileName ToNoteFile)
(* * 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
PromptWindow)
(NC.ClearMsg PromptWindow)))
((type? NoteFile FromNoteFile)
(fetch (NoteFile FullFileName) of FromNoteFile))
(T FromNoteFile)))
(* * If compact to target, get the name of the target file)
(if (NULL InPlaceFlg)
then (SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
(FULLNAME FromFileName)))
(SETQ ToFileName (OR ToFileName (PROG1 (NC.DatabaseFileName
"Name of target of compaction:"
" -- " T NIL
NIL
PromptWindow)
(NC.ClearMsg PromptWindow)))))
(* * As long as you have file names, go ahead!)
(if (AND FromFileName (OR InPlaceFlg ToFileName))
then
(* * Make full name for source file.)
(SETQ FromFileName (FULLNAME FromFileName (QUOTE OLD)))
(* SETQ ToFileName (FULLNAME ToFileName
(QUOTE NEW)))
(* * Close the file if its open)
(if (AND (SETQ FromNoteFile (NC.NoteFileFromFileName FromFileName))
(OPENP FromFileName))
then (NC.CloseDatabaseFile FromNoteFile))
(* * Compact the file and reopen if successfull and was previously open)
(NC.PrintMsg PromptWindow T "Compacting " FromFileName " ...")
(if (SETQ ToNoteFile (if InPlaceFlg
then (NC.AutoloadApply* (FUNCTION
NC.CompactNoteFileInPlace)
(OR FromNoteFile
FromFileName)
PromptWindow)
else (* compact to target)
(NC.AutoloadApply* (FUNCTION
NC.CompactNoteFileToTarget)
(OR FromNoteFile
FromFileName)
ToFileName PromptWindow)))
then (NC.ClearMsg PromptWindow T)))
ToNoteFile)))
)
(PUTPROPS PMIPATCH048 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1244 27247 (NC.CreateNoteFile 1254 . 9113) (NC.OpenNoteFile 9115 . 27245)) (27281 32261
(NC.CompactNoteFileToTarget 27291 . 32259)) (32299 36055 (NCLocalDevice.CompactNoteFile 32309 . 36053
)))))
STOP