(FILECREATED "10-Dec-86 17:44:19" {QV}<NOTECARDS>1.3K>NEXT>NCHASHCARD.;14 8575
changes to: (VARS NCHASHCARDCOMS)
previous date: " 4-Nov-86 17:14:50" {QV}<NOTECARDS>1.3K>NEXT>NCHASHCARD.;13)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCHASHCARDCOMS)
(RPAQQ NCHASHCARDCOMS ((* * Stuff for the hash card type. This includes the basic general hash card
and a specialization called Registry card type.)
(GLOBALVARS NC.DefaultHashCardHashArraySize)
(INITVARS (NC.DefaultHashCardHashArraySize 100))
(FNS NC.AddHashCard NC.HashCardMakeFn NC.HashCardEditFn NC.HashCardGetFn
NC.HashCardPutFn NC.HashCardCopyFn)
(P (NC.AddHashCard))
(FNS NCAddStub.HashCard)
(* * This is a specialization of Hash card called Registry card. It maps
atoms to UIDs and has tailored Get and Put fns.)
(GLOBALVARS NC.RegistrySubstanceEndMarker
NC.DefaultRegistryCardHashArraySize)
(INITVARS (NC.DefaultRegistryCardHashArraySize 100)
(NC.RegistrySubstanceEndMarker (QUOTE ##EndRegistrySubstance##)))
(FNS NC.AddRegistryCard NC.RegistryCardMakeFn NC.RegistryCardGetFn
NC.RegistryCardPutFn)
(FNS NC.RegisterCardByName NC.LookupCardByName NC.UnregisterName)
(P (NC.AddRegistryCard))))
(* * Stuff for the hash card type. This includes the basic general hash card and a
specialization called Registry card type.)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.DefaultHashCardHashArraySize)
)
(RPAQ? NC.DefaultHashCardHashArraySize 100)
(DEFINEQ
(NC.AddHashCard
(LAMBDA NIL (* rht: "14-Jul-86 01:07")
(* * rht 7/14/86: No longer has a QuitFn.)
(NC.AddCardType (QUOTE Hash)
(QUOTE NoteCard)
(BQUOTE ((MakeFn , (FUNCTION NC.HashCardMakeFn))
(EditFn , (FUNCTION NC.HashCardEditFn))
(GetFn , (FUNCTION NC.HashCardGetFn))
(PutFn , (FUNCTION NC.HashCardPutFn))
(CopyFn , (FUNCTION NC.HashCardCopyFn))
(MarkDirtyFn , (FUNCTION NILL))
(DirtyPFn , (FUNCTION NILL))
(QuitFn , (FUNCTION NILL))))
(QUOTE ((LinkAnchorModesSupported NIL))))))
(NC.HashCardMakeFn
(LAMBDA (Card Title NoDisplayFlg HASHARRAYArgs) (* rht: "26-Feb-86 10:21")
(* * Make a hash substance. HASHARRAYArgs should be a list of arguments to the HASHARRAY call.
HASHARRAYArgs should be a list the first element of which is a positive integer. Otherwise use default.)
(if (OR (NOT (LISTP HASHARRAYArgs))
(NOT (AND (FIXP (CAR HASHARRAYArgs))
(GREATERP (CAR HASHARRAYArgs)
0))))
then (SETQ HASHARRAYArgs (LIST NC.DefaultHashCardHashArraySize)))
(NC.SetSubstance Card (APPLY (FUNCTION HASHARRAY)
HASHARRAYArgs))
Card))
(NC.HashCardEditFn
(LAMBDA NIL (* rht: "26-Feb-86 10:22")
(NC.ReportError NIL "Cannot edit a hash substance")))
(NC.HashCardGetFn
(LAMBDA (Card Length Stream) (* kirk: "16-Sep-86 17:34")
(* * Get the hash substance from the disk)
(* * 9/16/86 changed READ to HREAD)
(HREAD Stream)))
(NC.HashCardPutFn
(LAMBDA (Card Stream) (* kirk: "16-Sep-86 17:33")
(* * Puts hash substance to notefile.)
(* * kirk 9/16/84 changed PRINT to HPRINT)
(HPRINT (NC.FetchSubstance Card)
Stream)
0))
(NC.HashCardCopyFn
(LAMBDA (Card FromStream ToStream Length) (* rht: "26-Feb-86 10:24")
(* * Copy a hash substance from FromStream to ToStream.)
(LET* ((FromStartPtr (GETFILEPTR FromStream))
(FromEndPtr (PLUS Length FromStartPtr)))
(COPYBYTES FromStream ToStream FromStartPtr FromEndPtr))
T))
)
(NC.AddHashCard)
(DEFINEQ
(NCAddStub.HashCard
(LAMBDA NIL (* kirk: "19-Jun-86 20:52")
(* * kirk 18Jun86 Add the text card stub)
(NC.AddCardTypeStub (QUOTE Hash)
(QUOTE NoteCard)
(QUOTE NCHASHCARD))))
)
(* * This is a specialization of Hash card called Registry card. It maps atoms to UIDs and has
tailored Get and Put fns.)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.RegistrySubstanceEndMarker NC.DefaultRegistryCardHashArraySize)
)
(RPAQ? NC.DefaultRegistryCardHashArraySize 100)
(RPAQ? NC.RegistrySubstanceEndMarker (QUOTE ##EndRegistrySubstance##))
(DEFINEQ
(NC.AddRegistryCard
(LAMBDA NIL (* rht: "26-Feb-86 11:09")
(NC.AddCardType (QUOTE Registry)
(QUOTE Hash)
(BQUOTE ((MakeFn , (FUNCTION NC.RegistryCardMakeFn))
(GetFn , (FUNCTION NC.RegistryCardGetFn))
(PutFn , (FUNCTION NC.RegistryCardPutFn))))
(QUOTE ((LinkAnchorModesSupported NIL))))))
(NC.RegistryCardMakeFn
(LAMBDA (Card Title NoDisplayFlg) (* rht: "26-Feb-86 11:09")
(* * Make a Registry substance.)
(NC.ApplySupersFn MakeFn Card Title NoDisplayFlg (LIST NC.DefaultRegistryCardHashArraySize))))
(NC.RegistryCardGetFn
[LAMBDA (Card Length Stream) (* rht: " 1-Nov-86 16:06")
(* * Get the Registry substance from the disk)
(* * rht 11/1/86: Now uses our readtable when reading.)
(DECLARE (GLOBALVARS NC.OrigReadTable NC.RegistrySubstanceEndMarker
NC.DefaultRegistryCardHashArraySize))
(LET [(HashArray (HASHARRAY NC.DefaultRegistryCardHashArraySize))
(EndLoc (PLUS Length (GETFILEPTR Stream]
(for bind Key eachtime (BLOCK) while (LESSP (GETFILEPTR Stream)
EndLoc)
until (EQ (SETQ Key (READ Stream NC.OrigReadTable))
NC.RegistrySubstanceEndMarker)
do (* Skip CR)
(BIN Stream)
(PUTHASH Key (NC.ReadUID Stream)
HashArray))
HashArray])
(NC.RegistryCardPutFn
[LAMBDA (Card Stream) (* rht: " 1-Nov-86 16:08")
(* * Puts Registry substance to notefile. Writes down atomic key followed by UID for each hash table pair.
Writes down special marker at the end.)
(* * rht 11/1/86: Now uses our readtable when printing.)
(DECLARE (GLOBALVARS NC.OrigReadTable NC.RegistrySubstanceEndMarker))
[MAPHASH (NC.FetchSubstance Card)
(FUNCTION (LAMBDA (Value Item)
(PRINT Item Stream)
(NC.WriteUID Stream Value]
(PRINT NC.RegistrySubstanceEndMarker Stream NC.OrigReadTable)
0])
)
(DEFINEQ
(NC.RegisterCardByName
(LAMBDA (RegistryCard Name Card) (* rht: "26-Feb-86 15:38")
(* * Stuff the item/val pair Name/Card into RegistryCard's hash array. Note that RegistryCard should be active when
this is called.)
(PUTHASH (MKATOM Name)
(fetch (Card UID) of Card)
(NC.FetchSubstance RegistryCard))
(NC.MarkCardDirty RegistryCard)))
(NC.LookupCardByName
(LAMBDA (RegistryCard Name) (* fgh: " 2-May-86 22:25")
(* * Look up in RegistryCard's hash array the card hash'ed by key Name. Note that RegistryCard must be active when
this is called.)
(* * fgh 5/2/86 Now handles case where no match is found in registry table!)
(LET ((UIDFound (GETHASH (MKATOM Name)
(NC.FetchSubstance RegistryCard))))
(if UIDFound
then (NC.CardFromUID UIDFound (fetch (Card NoteFile) of RegistryCard))))))
(NC.UnregisterName
(LAMBDA (RegistryCard Name) (* rht: "26-Feb-86 15:39")
(* * Remove any entry for Name from RegistryCard's hash array. Note that RegistryCard should be active when this is
called.)
(PUTHASH (MKATOM Name)
NIL
(NC.FetchSubstance RegistryCard))
(NC.MarkCardDirty RegistryCard)))
)
(NC.AddRegistryCard)
(PUTPROPS NCHASHCARD COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1580 4059 (NC.AddHashCard 1590 . 2261) (NC.HashCardMakeFn 2263 . 2953) (
NC.HashCardEditFn 2955 . 3131) (NC.HashCardGetFn 3133 . 3385) (NC.HashCardPutFn 3387 . 3685) (
NC.HashCardCopyFn 3687 . 4057)) (4077 4366 (NCAddStub.HashCard 4087 . 4364)) (4741 7026 (
NC.AddRegistryCard 4751 . 5165) (NC.RegistryCardMakeFn 5167 . 5438) (NC.RegistryCardGetFn 5440 . 6346)
(NC.RegistryCardPutFn 6348 . 7024)) (7027 8473 (NC.RegisterCardByName 7037 . 7478) (
NC.LookupCardByName 7480 . 8071) (NC.UnregisterName 8073 . 8471)))))
STOP