(FILECREATED " 7-Nov-86 16:33:47" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH139.;4 17941
changes to: (VARS RHTPATCH139COMS)
(FNS NCAddStub.GraphCard NCAddStub.SketchCard NC.AddGraphCard
NCAddStub.BrowserCard NCAddStub.IdeaSketchCard NC.AddCardType
NC.CardTypeStubLoader NCAddStub.LinkIndexCard NCAddStub.SearchCard
NC.InheritFieldsFromSuperType NC.PropagateCardTypeFieldsDownward
NC.AddCardTypeStub)
(RECORDS NoteCardType)
previous date: " 7-Nov-86 14:28:01" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH139.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH139COMS)
(RPAQQ RHTPATCH139COMS ((* * Changes to types mech to install new scheme for stub loading and
inheritance through \\FILLME// fields.)
(FILES (FROM NOTECARDS)
NCGRAPHCARD NCBROWSERCARD NCSKETCHCARD NCSEARCHCARD NCLINKINDEXCARD)
(* * Changes to NCTYPESMECH)
(FNS NC.AddCardTypeStub NC.AddCardType NC.InheritFieldsFromSuperType
NC.PropagateCardTypeFieldsDownward NC.CardTypeStubLoader)
(RECORDS NoteCardType)
(* * Changes to NCGRAPHCARD)
(FNS NCAddStub.GraphCard)
(* * Changes to NCBROWSERCARD)
(FNS NCAddStub.BrowserCard)
(* * Changes to NCSKETCHCARD)
(FNS NCAddStub.SketchCard)
(* * Changes to NCSEARCHCARD)
(FNS NCAddStub.SearchCard)
(* * Changes to NCLINKINDEXCARD)
(FNS NCAddStub.LinkIndexCard)))
(* * Changes to types mech to install new scheme for stub loading and inheritance through
\\FILLME// fields.)
(FILESLOAD (FROM NOTECARDS)
NCGRAPHCARD NCBROWSERCARD NCSKETCHCARD NCSEARCHCARD NCLINKINDEXCARD)
(* * Changes to NCTYPESMECH)
(DEFINEQ
(NC.AddCardTypeStub
(LAMBDA (TypeName SuperType FullDefinitionFileName FnsAssocList VarsAssocList ListOfFILLMEFields)
(* rht: " 7-Nov-86 14:55")
(* * Create a card type stub to hold as a place holder until the actual card type is autoloaded.)
(* * If FullDefinitionFileName is not supplied, one is constructed from the type name.)
(* * kirk 18Jun86 Changed to use FullDefinitionFileName and deal with NIL or UnLoaded SuperType.
Now gets called recursively in that case. Hence, the above warning.)
(* * fgh 8/26/86 Revamped. Now attempts to load supertype stub or whole definition if not already loaded.
Must be called with valid SuperType arg.)
(* * rht 11/7/86: Now just calls NC.AddCardType with StubFlg = T.)
(NC.AddCardType TypeName SuperType FnsAssocList VarsAssocList FullDefinitionFileName
ListOfFILLMEFields T)))
(NC.AddCardType
(LAMBDA (TypeName SuperType FnsAssocList VarsAssocList FullDefinitionFile ListOfFILLMEFields
StubFlg) (* rht: " 7-Nov-86 16:17")
(* * Create a new note card type and link it into the card type heirarchy.)
(* * fgh 1/31/86 Updated to handle card type hash table.)
(* * fgh 2/3/86 Updated to do inheritance at definition time rather than at access time.)
(* * rht 7/15/86: Innards replaced by call to NC.ModifyCardType.)
(* * rht 11/7/86: Now accepts ListOfFILLMEFields arg. Any such fields get the \\FILLME// atom as value.
No longer forces load of super. Takes three extra optional args StubFlg, FullDefinitionFile, and
ListOfFILLMEFields.)
(LET (NewType (MainFieldNames (CONSTANT (for FieldName in (RECORDFIELDNAMES (QUOTE
NoteCardType))
when (NEQ (QUOTE InheritedFlg)
(SUBATOM FieldName -12 -1))
collect FieldName))))
(COND
((NULL TypeName)
(NC.ReportError "NC.AddCardType" "Illegal type name: NIL"))
((NULL SuperType)
(NC.ReportError "NC.AddCardType" "Illegal super type name: NIL")))
(* * Create new NoteCardType)
(SETQ NewType (create NoteCardType
TypeName ← TypeName
SuperType ← SuperType
StubFlg ← StubFlg
FullDefinitionFile ← FullDefinitionFile))
(* * If it's a stub, then change the default values for fields from \\FILLME// to \\EMPTY// except for those in
ListOfFILLMEFields.)
(if StubFlg
then (for FieldName in MainFieldNames unless (FMEMB FieldName
ListOfFILLMEFields)
when (EQ (RECORDACCESS (BQUOTE (NoteCardType , FieldName))
NewType NIL (QUOTE fetch))
(QUOTE \\FILLME//))
do (RECORDACCESS (BQUOTE (NoteCardType , FieldName))
NewType NIL (QUOTE replace)
(QUOTE \\EMPTY//))))
(* * Compute fields, inheriting from above and propagating downward.)
(NC.ModifyCardType NewType FnsAssocList VarsAssocList)
(* * Stash the new card type record, reset the menu and then return.)
(PUTHASH TypeName NewType NC.CardTypes)
(SETQ NC.NoteCardTypeMenu)
NewType)))
(NC.InheritFieldsFromSuperType
(LAMBDA (TypeNameOrRecord SuperTypeRecord) (* rht: " 7-Nov-86 15:13")
(* * Inherit fields from super card type record if the supertype is not a stub.)
(* * fgh 2/3/86 First created.)
(* * fgh 8/26/86 Now uses SuperTypeRecord consistently if it is present.)
(* * rht 11/7/86: Changed procedure for deciding when to inherit a field from upstairs.)
(LET ((TypeRecord (if (type? NoteCardType TypeNameOrRecord)
then TypeNameOrRecord
else (NC.CardTypeRecord TypeNameOrRecord)))
(InheritedFlgNames (CONSTANT (for FieldName in (RECORDFIELDNAMES (QUOTE
NoteCardType))
when (EQ (QUOTE InheritedFlg)
(SUBATOM FieldName -12 -1))
collect FieldName))))
(OR SuperTypeRecord (SETQ SuperTypeRecord (NC.CardTypeRecord (fetch (NoteCardType
SuperType)
of TypeRecord))))
(for FlgName in InheritedFlgNames
do (LET ((FieldName (SUBATOM FlgName 1 -13))
FieldValue SuperFieldValue)
(SETQ FieldValue (RECORDACCESS (BQUOTE (NoteCardType , FieldName))
TypeRecord NIL (QUOTE fetch)))
(SETQ SuperFieldValue (RECORDACCESS (BQUOTE (NoteCardType , FieldName))
SuperTypeRecord NIL (QUOTE fetch)))
(* * Only inherit from the super field if it's got a real value, and if either the subfield has value \\FILLME// or
the InheritedFlg field says to inherit. Don't inherit if the subfield is \\EMPTY//, cause that indicates a field
for a stub that shouldn't inherit.)
(if (AND (NOT (FMEMB SuperFieldValue (QUOTE (\\FILLME// \\EMPTY//))))
(NOT (EQ FieldValue (QUOTE \\EMPTY//)))
(OR (EQ FieldValue (QUOTE \\FILLME//))
(RECORDACCESS (BQUOTE (NoteCardType , FlgName))
TypeRecord NIL (QUOTE fetch))))
then (RECORDACCESS (BQUOTE (NoteCardType , FieldName))
TypeRecord NIL (QUOTE replace)
SuperFieldValue)))))))
(NC.PropagateCardTypeFieldsDownward
(LAMBDA (TypeNameOrRecord) (* rht: " 7-Nov-86 14:54")
(* * For all subtypes of TypeNameOrRecord, inherit fields from TypeNameOrRecord.)
(* * fgh 2/3/86 First created.)
(* * rht 11/7/86: Fixed minor typo.)
(for SubType in (NC.SubTypesOfCardType (if (type? NoteCardType TypeNameOrRecord)
then (fetch (NoteCardType TypeName)
of TypeNameOrRecord)
else TypeNameOrRecord))
do (NC.InheritFieldsFromSuperType SubType (if (type? NoteCardType TypeNameOrRecord)
then TypeNameOrRecord
else NIL))
(NC.PropagateCardTypeFieldsDownward SubType))))
(NC.CardTypeStubLoader
(LAMBDA (TypeName FileSuggestion) (* rht: " 7-Nov-86 16:22")
(* * Load card type TypeName using FileSuggestion as the first place to look. Otherwise look in the directories
specified by NoteCardsDirectories.)
(* * fgh 2/3/86 First written.)
(* * kirk 6/20/86 Added NCP.Add...CardStub fn load and call)
(* * kirk 9/9/86 Changed the name of the FN to search for to NCAddStub...Card)
(* * kirk 9/21/86 added RESETLST)
(* * rg 10/21/86: Changed to use simpler scheme for finding files)
(* * rht&rg 11/7/86: Now passes (QUOTE VARS) arg to LOADFNS so that interesting vars like link icon bitmap will be
loaded. There ought to be a better way.)
(LET* ((FileName (NC.FindFile FileSuggestion TypeName T))
(oldFILEDATES (GETPROP FileName (QUOTE FILEDATES)))
AddTypeFn AddTypeForm)
(if FileName
then (RESETLST (RESETSAVE NIL (BQUOTE (COND
(oldFILEDATES
(PUTPROP , (LIST (QUOTE QUOTE)
FileName)
(QUOTE FILEDATES)
oldFILEDATES))
(T (REMPROP , (LIST (QUOTE QUOTE)
FileName)
(QUOTE FILEDATES))))))
(* * Load and eval the NC.Add...CardStub fn)
(SETQ AddTypeFn (PACK* (QUOTE NCAddStub.)
TypeName
(QUOTE Card)))
(SETQ AddTypeForm (LOADFNS AddTypeFn FileName NIL (QUOTE
VARS)))
(NC.FixFileDates FileName)
(if (EQ (CAAR AddTypeForm)
(QUOTE NOT-FOUND:))
then (NC.ReportError "NC.CardTypeStubLoader"
(CONCAT
"NoteCards: Can't find card type stub init procedure: "
AddTypeFn " in " FileName ".")
)))
(* * this should call NC.AddCardTypeStub)
(EVAL AddTypeForm)))))
)
[DECLARE: EVAL@COMPILE
(DATATYPE NoteCardType (TypeName SuperType StubFlg FullDefinitionFile MakeFn (MakeFnInheritedFlg
FLAG)
EditFn
(EditFnInheritedFlg FLAG)
QuitFn
(QuitFnInheritedFlg FLAG)
GetFn
(GetFnInheritedFlg FLAG)
PutFn
(PutFnInheritedFlg FLAG)
CopyFn
(CopyFnInheritedFlg FLAG)
MarkDirtyFn
(MarkDirtyFnInheritedFlg FLAG)
DirtyPFn
(DirtyPFnInheritedFlg FLAG)
CollectLinksFn
(CollectLinksFnInheritedFlg FLAG)
DeleteLinksFn
(DeleteLinksFnInheritedFlg FLAG)
UpdateLinkIconsFn
(UpdateLinkIconsFnInheritedFlg FLAG)
InsertLinkFn
(InsertLinkFnInheritedFlg FLAG)
TranslateWindowPositionFn
(TranslateWindowPositionFnInheritedFlg FLAG)
LinkDisplayMode
(LinkDisplayModeInheritedFlg FLAG)
DefaultWidth
(DefaultWidthInheritedFlg FLAG)
DefaultHeight
(DefaultHeightInheritedFlg FLAG)
LinkAnchorModesSupported
(LinkAnchorModesSupportedInheritedFlg FLAG)
DisplayedInMenuFlg
(DisplayedInMenuFlgInheritedFlg FLAG)
LinkIconAttachedBitMap
(LinkIconAttachedBitMapInheritedFlg FLAG)
LeftButtonMenuItems
(LeftButtonMenuItemsInheritedFlg FLAG)
MiddleButtonMenuItems
(MiddleButtonMenuItemsInheritedFlg FLAG))
MakeFnInheritedFlg ← T EditFnInheritedFlg ← T QuitFnInheritedFlg ← T GetFnInheritedFlg ← T
PutFnInheritedFlg ← T CopyFnInheritedFlg ← T MarkDirtyFnInheritedFlg ← T
DirtyPFnInheritedFlg ← T CollectLinksFnInheritedFlg ← T DeleteLinksFnInheritedFlg ← T
UpdateLinkIconsFnInheritedFlg ← T InsertLinkFnInheritedFlg ← T
TranslateWindowPositionFnInheritedFlg ← T LinkDisplayModeInheritedFlg ← T
DefaultWidthInheritedFlg ← T DefaultWidthInheritedFlg ← T DefaultHeightInheritedFlg ← T
LinkAnchorModesSupportedInheritedFlg ← T LinkIconAttachedBitMapInheritedFlg ← T
LeftButtonMenuItemsInheritedFlg ← T MiddleButtonMenuItemsInheritedFlg ← T
DisplayedInMenuFlgInheritedFlg ← NIL MakeFn ←(QUOTE \\FILLME//)
EditFn ←(QUOTE \\FILLME//)
QuitFn ←(QUOTE \\FILLME//)
GetFn ←(QUOTE \\FILLME//)
PutFn ←(QUOTE \\FILLME//)
CopyFn ←(QUOTE \\FILLME//)
MarkDirtyFn ←(QUOTE \\FILLME//)
DirtyPFn ←(QUOTE \\FILLME//)
CollectLinksFn ←(QUOTE \\FILLME//)
DeleteLinksFn ←(QUOTE \\FILLME//)
UpdateLinkIconsFn ←(QUOTE \\FILLME//)
InsertLinkFn ←(QUOTE \\FILLME//)
TranslateWindowPositionFn ←(QUOTE \\FILLME//)
LinkDisplayMode ←(QUOTE \\FILLME//)
DefaultWidth ←(QUOTE \\FILLME//)
DefaultHeight ←(QUOTE \\FILLME//)
LinkAnchorModesSupported ←(QUOTE \\FILLME//)
DisplayedInMenuFlg ←(QUOTE \\FILLME//)
LinkIconAttachedBitMap ←(QUOTE \\FILLME//)
LeftButtonMenuItems ←(QUOTE \\FILLME//)
MiddleButtonMenuItems ←(QUOTE \\FILLME//))
]
(/DECLAREDATATYPE (QUOTE NoteCardType)
(QUOTE (POINTER POINTER POINTER POINTER POINTER FLAG POINTER FLAG POINTER FLAG
POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG
POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG
POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG
POINTER FLAG POINTER FLAG POINTER FLAG))
(QUOTE ((NoteCardType 0 POINTER)
(NoteCardType 2 POINTER)
(NoteCardType 4 POINTER)
(NoteCardType 6 POINTER)
(NoteCardType 8 POINTER)
(NoteCardType 8 (FLAGBITS . 0))
(NoteCardType 10 POINTER)
(NoteCardType 10 (FLAGBITS . 0))
(NoteCardType 12 POINTER)
(NoteCardType 12 (FLAGBITS . 0))
(NoteCardType 14 POINTER)
(NoteCardType 14 (FLAGBITS . 0))
(NoteCardType 16 POINTER)
(NoteCardType 16 (FLAGBITS . 0))
(NoteCardType 18 POINTER)
(NoteCardType 18 (FLAGBITS . 0))
(NoteCardType 20 POINTER)
(NoteCardType 20 (FLAGBITS . 0))
(NoteCardType 22 POINTER)
(NoteCardType 22 (FLAGBITS . 0))
(NoteCardType 24 POINTER)
(NoteCardType 24 (FLAGBITS . 0))
(NoteCardType 26 POINTER)
(NoteCardType 26 (FLAGBITS . 0))
(NoteCardType 28 POINTER)
(NoteCardType 28 (FLAGBITS . 0))
(NoteCardType 30 POINTER)
(NoteCardType 30 (FLAGBITS . 0))
(NoteCardType 32 POINTER)
(NoteCardType 32 (FLAGBITS . 0))
(NoteCardType 34 POINTER)
(NoteCardType 34 (FLAGBITS . 0))
(NoteCardType 36 POINTER)
(NoteCardType 36 (FLAGBITS . 0))
(NoteCardType 38 POINTER)
(NoteCardType 38 (FLAGBITS . 0))
(NoteCardType 40 POINTER)
(NoteCardType 40 (FLAGBITS . 0))
(NoteCardType 42 POINTER)
(NoteCardType 42 (FLAGBITS . 0))
(NoteCardType 44 POINTER)
(NoteCardType 44 (FLAGBITS . 0))
(NoteCardType 46 POINTER)
(NoteCardType 46 (FLAGBITS . 0))
(NoteCardType 48 POINTER)
(NoteCardType 48 (FLAGBITS . 0))))
(QUOTE 50))
(* * Changes to NCGRAPHCARD)
(DEFINEQ
(NCAddStub.GraphCard
(LAMBDA NIL (* rht: " 7-Nov-86 16:33")
(* * kirk 18Jun86 Add the Graph card stub)
(* * rht 11/7/86: Fixed typo, changing a QUOTE to BQUOTE.)
(DECLARE (GLOBALVARS NC.GraphCardIcon))
(NC.AddCardTypeStub (QUOTE Graph)
(QUOTE NoteCard)
(QUOTE NCGRAPHCARD)
NIL
(BQUOTE ((DisplayedInMenuFlg T)
(LinkIconAttachedBitMap , NC.GraphCardIcon))))))
)
(* * Changes to NCBROWSERCARD)
(DEFINEQ
(NCAddStub.BrowserCard
(LAMBDA NIL (* rht: " 7-Nov-86 16:14")
(* * kirk 18Jun86 Add the Browser card stub)
(* * rht 11/7/86: Now passes down a \\FILLME// field.)
(NC.AddCardTypeStub (QUOTE Browser)
(QUOTE Graph)
(QUOTE NCBROWSERCARD)
NIL
(QUOTE ((DisplayedInMenuFlg T)))
(QUOTE (LinkIconAttachedBitmap)))))
)
(* * Changes to NCSKETCHCARD)
(DEFINEQ
(NCAddStub.SketchCard
(LAMBDA NIL (* rht: " 7-Nov-86 16:33")
(* * kirk 18Jun86 Add the Sketch card stub)
(* * rht 11/7/86: Fixed typo, changing a QUOTE to BQUOTE.)
(DECLARE (GLOBALVARS NC.SketchCardIcon))
(NC.AddCardTypeStub (QUOTE Sketch)
(QUOTE NoteCard)
(QUOTE NCSKETCHCARD)
NIL
(BQUOTE ((DisplayedInMenuFlg T)
(LinkIconAttachedBitMap , NC.SketchCardIcon))))))
)
(* * Changes to NCSEARCHCARD)
(DEFINEQ
(NCAddStub.SearchCard
(LAMBDA NIL (* rht: " 7-Nov-86 16:30")
(* * kirk 18Jun86 Add the Search card stub)
(* * rht 11/7/86: Now passes down a \\FILLME// field.)
(NC.AddCardTypeStub (QUOTE Search)
(QUOTE Text)
(QUOTE NCSEARCHCARD)
NIL
(QUOTE ((DisplayedInMenuFlg T)))
(QUOTE (LinkIconAttachedBitmap)))))
)
(* * Changes to NCLINKINDEXCARD)
(DEFINEQ
(NCAddStub.LinkIndexCard
(LAMBDA NIL (* rht: " 7-Nov-86 16:31")
(* * kirk 18Jun86 Add the LinkIndex card stub)
(* * rht 11/7/86: Now passes down a \\FILLME// field.)
(NC.AddCardTypeStub (QUOTE LinkIndex)
(QUOTE Text)
(QUOTE NCLINKINDEXCARD)
NIL
(QUOTE ((DisplayedInMenuFlg T)))
(QUOTE (LinkIconAttachedBitmap)))))
)
(PUTPROPS RHTPATCH139 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1694 10296 (NC.AddCardTypeStub 1704 . 2711) (NC.AddCardType 2713 . 5205) (
NC.InheritFieldsFromSuperType 5207 . 7443) (NC.PropagateCardTypeFieldsDownward 7445 . 8240) (
NC.CardTypeStubLoader 8242 . 10294)) (15263 15788 (NCAddStub.GraphCard 15273 . 15786)) (15826 16288 (
NCAddStub.BrowserCard 15836 . 16286)) (16325 16856 (NCAddStub.SketchCard 16335 . 16854)) (16893 17350
(NCAddStub.SearchCard 16903 . 17348)) (17390 17859 (NCAddStub.LinkIndexCard 17400 . 17857)))))
STOP