(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")

(FILECREATED "31-Dec-87 21:43:11" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH301.;2
 7089   

      changes to%:  (FNS NC.CompactNoteFileInPlace)
                    (VARS RHTPATCH301COMS)
                    (PROPS (RHTPATCH301 MAKEFILE-ENVIRONMENT))

      previous date%: "31-Dec-87 21:41:44" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH301.;1)


(* "
Copyright (c) 1987 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT RHTPATCH301COMS)

(RPAQQ RHTPATCH301COMS
 ((DECLARE%: DONTCOPY (PROPS (RHTPATCH301 MAKEFILE-ENVIRONMENT)
                                                   (RHTPATCH301 FILETYPE)))
                        [DECLARE%: FIRST (P (NC.LoadFileFromDirectories 'NCCOMPACT]
                        
          
          (* ;; "Fixes call to SETFILEINFO to take stream arg rather than filename.  Wonder if there are any other calls to SETFILEINFO.")


                        
          
          (* ;; "Change to NCCOMPACT")


                        (FNS NC.CompactNoteFileInPlace)))
(DECLARE%: DONTCOPY 

(PUTPROPS RHTPATCH301 MAKEFILE-ENVIRONMENT
 (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))

(PUTPROPS RHTPATCH301 FILETYPE
 :TCOMPL)
)
(DECLARE%: FIRST 
(NC.LoadFileFromDirectories 'NCCOMPACT)
)



(* ;; 
"Fixes call to SETFILEINFO to take stream arg rather than filename.  Wonder if there are any other calls to SETFILEINFO."
)





(* ;; "Change to NCCOMPACT")


(DEFINEQ

(NC.CompactNoteFileInPlace

  [LAMBDA (NoteFile InterestedWindow)
                        (* ; "Edited 31-Dec-87 21:43 by Trigg")

          
          (* ;; "Compact the notefile in place.  If index needs to be increased, then first make room for bigger index by copying.  Compaction is done by sorting index pointers and moving each entry in the file to lower addresses.")

          
          (* ;; "fkr 11/8/85 Updated to handle new CardID scheme and NoteFile object.")

          
          (* ;; "kirk 19Nov85: Created from NC.CompactDatabaseInPlace")

          
          (* ;; "rht 11/3/86: Added InterestedWindow arg.")

          
          (* ;; "rht&pmi 12/9/86: Moved RESETLST to be after call to NC.OpenDatabaseFile.")

          
          (* ;; "rht 1/22/87: Now bails out if NC.ExpandIndexInPlace was called but returned NIL.  Also fixed message when size of notefile actually increases.")

          
          (* ;; "rht 5/16/87: No longer calls NC.ExpandIndexInPlace.")

          
          (* ;; "pmi 5/20/87: Removed HashArray argument in calls to NC.OpenNoteFile.")

          
          (* ;; 

          "rht 12/31/87: Changed call to SETFILEINFO to pass Stream argument rather than file name.")


    (DECLARE
 (GLOBALVARS PROMPTWINDOW))
    (if
 (AND NoteFile (SETQ NoteFile (NC.OpenNoteFile NoteFile T T NIL NIL T T T InterestedWindow)))
        then
 (RESETLST
              [RESETSAVE NIL `(NC.ForceDatabaseClose ,NoteFile]
              (LET ((SourceStream (fetch
 (NoteFile Stream) of
 NoteFile))
                    [BufferStream (OPENSTREAM '{NODIRCORE} 'BOTH NIL '((TYPE BINARY]
                    (FullFileName (fetch
 (NoteFile FullFileName) of
 NoteFile))
                    ToPtr OriginalLengthOfFile OperationMsg)
          
          (* ;; "Expand index if needed.")


                   (SETQ OperationMsg (CONCAT "Compacting " FullFileName " in place." (CHARACTER
                                                                                       13)))
                   (SETQ OriginalLengthOfFile (GETEOFPTR SourceStream))
          
          (* ;; 

    "In sorted order, copy entries to lower locations in the file.  Expand index first if necessary.")


                   (if
 (SETQ ToPtr (NC.CopySortedCardParts (NC.SortIndexEntries NoteFile)
                                          NIL
                                          (NC.TotalIndexSize (fetch
 (NoteFile HashArraySize)
                                                                of
 NoteFile))
                                          BufferStream
                                          (GETEOFPTR SourceStream)
                                          InterestedWindow OperationMsg))
                       then
                                  (* ; "all useable card parts got copied")


                            (NC.PutCheckptPtr NoteFile ToPtr) 
                                                             (* ; 

                                                             "Put out the new ChkptPtr to the file.")

          
          (* ;; "Truncate file at that point.")


                            (NC.PrintMsg InterestedWindow T "Truncating file " FullFileName " ...")
                            (NCLocalDevice.PutHashArray NoteFile InterestedWindow T OperationMsg)
                            (if
 (NOT (SETFILEINFO SourceStream 'LENGTH ToPtr))
                                then
 (NC.PrintMsg InterestedWindow NIL "Couldn't truncate " 
                                            FullFileName "." (CHARACTER 13))
                              else
 (NC.PrintMsg InterestedWindow T "Done." (CHARACTER 13))
                                   (NC.ClearMsg InterestedWindow T))
                            [LET ((NumBytesSaved (DIFFERENCE OriginalLengthOfFile ToPtr)))
                                 (if
 (MINUSP NumBytesSaved)
                                     then
 (NC.PrintMsg NIL T FullFileName " compacted in place."
                                                 (CHARACTER 13)
                                                 "Increased by "
                                                 (MINUS NumBytesSaved)
                                                 " bytes ("
                                                 (FIX (TIMES 100 (FQUOTIENT (MINUS NumBytesSaved)
                                                                        OriginalLengthOfFile)))
                                                 "%%)"
                                                 (CHARACTER 13))
                                   else
 (NC.PrintMsg NIL T FullFileName " compacted in place."
                                               (CHARACTER 13)
                                               "Recovered " NumBytesSaved " bytes ("
                                               (FIX (TIMES 100 (FQUOTIENT NumBytesSaved 
                                                                      OriginalLengthOfFile)))
                                               "%%)"
                                               (CHARACTER 13]
                            (SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME 'VERSION NIL
                                                                       'BODY FullFileName))
                     else
 (FLASHW PROMPTWINDOW)
                          (NC.PrintMsg NIL T "Compact of " FullFileName " cancelled."])
)
(PUTPROPS RHTPATCH301 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1468 7006 (NC.CompactNoteFileInPlace 1478 . 7004)))))
STOP