(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