(FILECREATED " 3-Jul-86 11:08:21" {QV}<NOTECARDS>1.3K>KIRKPATCH009.;5 7632
changes to: (FNS NC.PostGreet NC.CardTypeLoader)
(MACROS NC.GetCardTypeField)
(VARS KIRKPATCH009COMS z)
previous date: "26-Jun-86 23:47:12" {QV}<NOTECARDS>1.3K>KIRKPATCH009.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT KIRKPATCH009COMS)
(RPAQQ KIRKPATCH009COMS ((* * New for NCCORE)
(GLOBALVARS NC.HowToLoad)
(* * Change for NCCORE)
(FNS NC.PostGreet)
(* * Changes to NCTYPESMECH)
(FNS NC.AddCardTypeStub NC.CardTypeLoader)
(MACROS NC.GetCardTypeField)))
(* * New for NCCORE)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.HowToLoad)
)
(* * Change for NCCORE)
(DEFINEQ
(NC.PostGreet
(LAMBDA NIL (* kirk: " 2-Jul-86 11:55")
(* * called when loading NOTECARDS and after each greet (for NOTECARDS sysout users))
(LET (FullFileName Type File)
(for Type in NOTECARDTYPESTUBS unless (OR (NC.CardTypeRecord Type)
(MEMB Type NOTECARDTYPES))
do (NC.AddCardTypeStub Type))
(for Type in NOTECARDTYPES do (NC.CardTypeLoader Type))
(* * Load the library packages requested by the user's NOTECARDSLIBRARYFILES parameters)
(for File in NOTECARDSLIBRARYFILES do (COND
((SETQ FullFileName
(OR (FINDFILE (PACK* File
(QUOTE .dcom))
T NOTECARDSDIRECTORIES)
(FINDFILE File T
NOTECARDSDIRECTORIES)))
(LOAD FullFileName NC.LOADFLG))
(T (PRINT (CONCAT
"NoteCards: Can't find library file: "
File "."))))))
(NCP.NoteCardsParameters NCINITIALGLOBALPARAMS)))
)
(* * Changes to NCTYPESMECH)
(DEFINEQ
(NC.AddCardTypeStub
(LAMBDA (TypeName SuperType FullDefinitionFileName FnsAssocList VarsAssocList)
(* kirk: "26-Jun-86 20:34")
(* * 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.)
(* * If SuperType is not supplied, the Type's NCP.Add...CardTypeStub is called. If the SuperType is supplied but
unloaded, it's stub is loaded.)
(* * When called from a card type's NCP.Add...CardTypeStub function, SuperType MUST be specified to avoid infinite
recusion.)
(* * kirk 18Jun86 Changed to use FullDefinitionFileName and deal with NIL or UnLoaded SuperType.
Now gets called recursively in that case. Hence, the above warning.)
(LET (NewType AddTypeFn AddTypeForm (MainFieldNames (CONSTANT (for FieldName
in (RECORDFIELDNAMES
(QUOTE NoteCardType))
when (NEQ (QUOTE
InheritedFlg)
(SUBATOM
FieldName -12
-1))
collect FieldName))))
(if (NULL TypeName)
then (NC.ReportError "NC.AddCardType" "Illegal type name: NIL"))
(OR (SETQ FullDefinitionFileName (NC.FindCardTypeFile TypeName))
(NC.PrintMsg NIL NIL "NC.AddCardTypeStub"
"NC.AddCardTypeStub can't find card type file for "
TypeName "."))
(if SuperType
then (if (NULL (NC.CardTypeRecord SuperType))
then (NC.AddCardTypeStub SuperType))
(* * Create new NoteCardType)
(SETQ NewType
(create NoteCardType
TypeName ← TypeName
SuperType ← SuperType
StubFlg ← T
FullDefinitionFile ← FullDefinitionFileName))
(for AssocPair in (APPEND FnsAssocList VarsAssocList)
when (FMEMB (CAR AssocPair)
MainFieldNames)
do
(* * Set the proper field to the given value)
(RECORDACCESS (BQUOTE (NoteCardType , (CAR AssocPair)))
NewType NIL (QUOTE replace)
(CADR AssocPair)))
(* * Stash the new card type record, reset the menu and then return.)
(PUTHASH TypeName NewType NC.CardTypes)
(SETQ NC.NoteCardTypeMenu)
NewType
else (NC.CardTypeStubLoader TypeName FullDefinitionFileName)))))
(NC.CardTypeLoader
(LAMBDA (TypeName FileSuggestion SameProcessFlg) (* kirk: " 2-Jul-86 17:06")
(* * 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 26Jun86 Changed to use NC.FindCardTypeFile)
(* * kirk 1Jul86 Added new process. If SameProcessFlg then the TTY window containing the loading messages will not
get closed.)
(* This does not work. The Process WINDOW PROP is not
set. Must create our own window.)
(LET (Process)
(if SameProcessFlg
then (NC.LoadCardType TypeName FileSuggestion)
else (ALLOW.BUTTON.EVENTS)
(SETQ Process (ADD.PROCESS (BQUOTE (NC.LoadCardType (QUOTE , TypeName)
(QUOTE ,
FileSuggestion)))
(QUOTE NAME)
(CONCAT "Loading " TypeName " Card program")))
(PROG1 (PROCESS.RESULT Process T)
(CLOSEW (PROCESSPROP Process (QUOTE WINDOW)))
(DEL.PROCESS Process))))))
)
(DECLARE: EVAL@COMPILE
(DEFMACRO NC.GetCardTypeField (FieldName CardTypeNameVariable)
(* * Fetch the card type datatype field passed directly for FieldName
(for the card type whose name is in a variable passed as the second parameter))
(* * rht 4/11/86: Was trying to autoload if field of card type was nil. Now only tries to
autoload if CardTypeRecord is nil or if StubFlg is non-nil.)
(* * fgh 4/25/86 Fix to above fix. Checks for CardTypeRecord before doing fetch's in 2
cluase of COND.)
(* * kirk&fgh 26Jun86 Added check for InheritedFlg to above fix. Changed to DEFMACRO)
(BQUOTE (LET ((CardTypeName , CardTypeNameVariable)
CardTypeRecord)
(SETQ CardTypeRecord (NC.CardTypeRecord CardTypeName))
(COND ((AND CardTypeRecord (NULL (fetch (NoteCardType StubFlg)
of CardTypeRecord)))
(fetch (NoteCardType , FieldName)
of CardTypeRecord))
((AND CardTypeRecord (fetch (NoteCardType StubFlg)
of CardTypeRecord)
(NOT (fetch (NoteCardType , (MKATOM (CONCAT FieldName
(QUOTE InheritedFlg))))
of CardTypeRecord))
(fetch (NoteCardType , FieldName)
of CardTypeRecord)))
((NC.AutoLoadCardType CardTypeName (QUOTE , FieldName)
(AND CardTypeRecord (fetch (NoteCardType
FullDefinitionFile)
of CardTypeRecord)))
(fetch (NoteCardType , FieldName)
of
(NC.CardTypeRecord CardTypeName)))
(T (NC.ReportError NIL (CONCAT "Unknown note card type: " CardTypeName
" or card type field name: "
(QUOTE , FieldName))))))))
)
(PUTPROPS KIRKPATCH009 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (768 1910 (NC.PostGreet 778 . 1908)) (1946 5886 (NC.AddCardTypeStub 1956 . 4617) (
NC.CardTypeLoader 4619 . 5884)))))
STOP