(FILECREATED "11-Sep-85 16:39:42" {QV}<NOTECARDS>RELEASE1.2I>NCFILEBOXCARD.;5
 6164   

      changes to:  (FNS NC.MakeContentsCard)

      previous date: "14-Jun-85 14:32:02" {QV}<NOTECARDS>RELEASE1.2I>NCFILEBOXCARD.;4)


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

(PRETTYCOMPRINT NCFILEBOXCARDCOMS)

(RPAQQ NCFILEBOXCARDCOMS
 ((E (SETQ NC.SystemDate (DATE))
			     (UNMARKASCHANGED (QUOTE NC.SystemDate)
					      (QUOTE VARS)))
			  (VARS NC.SystemDate)
			  (GLOBALVARS NC.MarkersInFileBoxesFlg NC.SubBoxMarkerLabel 
				      NC.FiledCardMarkerLabel NC.AlphabetizedFileBoxChildrenFlg)
			  (P (UNMARKASCHANGED (QUOTE NC.SystemDate)
					      (QUOTE VARS)))
			  (FILES NCTEXTSUBSTANCE NCTEXTCARD)
			  (FNS NC.ContentsCardP NC.MakeContentsCard NC.FileBoxCollectChildren)
			  (FNS NC.AddFileBoxCard)
			  (P (NC.AddFileBoxCard))))

(RPAQQ NC.SystemDate
 "11-Sep-85 16:39:44")
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS NC.MarkersInFileBoxesFlg NC.SubBoxMarkerLabel NC.FiledCardMarkerLabel 
	    NC.AlphabetizedFileBoxChildrenFlg)
)
(UNMARKASCHANGED (QUOTE NC.SystemDate)
		 (QUOTE VARS))
(FILESLOAD NCTEXTSUBSTANCE NCTEXTCARD)
(DEFINEQ

(NC.ContentsCardP

  (LAMBDA (ID DatabaseStream)                                (* fgh: " 7-Nov-84 21:23")

                                                             (* Return T if ID is a CONTENTS card.)

    (
OR
 (
EQ
 (
QUOTE
 FileBox)
	    (
NC.RetrieveType
 ID (
OR
 DatabaseStream PSA.Database)))
	(
PROGN
 (
NC.PrintMsg
 NIL T ID " is not a FileBox.  Please choose again." (
CHARACTER
 13))
	       NIL))))

(NC.MakeContentsCard

  (LAMBDA (ID Title DontDisplay)                             (* rht: "11-Sep-85 16:34")

                                                             (* Make up a blank contents card, hook it to the user 

							     specified parent contents cards, and display it.)


          (* * rht 12/2/84: In DontDisplay case, changed to return ID rather than TextStream.)




          (* * rht 12/8/84: Massive shaving. Took out code to force filing now (at creation time))




          (* * rht 9/11/85: Took out insertion of spacer when no markers.)



    (LET (Window TextStream (Spacer (
CONCAT
 (
CHARACTER
 13)
					    (
CHARACTER
 13))))
      (
SETQ
 TextStream (
OPENTEXTSTREAM
 ""))
      (if
 NC.MarkersInFileBoxesFlg
	  then
 (
TEDIT.INSERT.OBJECT
 (
NC.MakePlaceMarker
 NC.SubBoxMarkerLabel)
				    TextStream 1)
	       (
TEDIT.INSERT
 TextStream Spacer 2)
	       (
TEDIT.INSERT.OBJECT
 (
NC.MakePlaceMarker
 NC.FiledCardMarkerLabel)
				    TextStream 4)
	       (
TEDIT.INSERT
 TextStream Spacer 5))
      (
NC.SetSubstance
 ID TextStream)
      (
NC.SetRegion
 ID (
CREATEREGION
 0 0 (
NC.DefaultCardWidth
 ID)
				     (
NC.DefaultCardHeight
 ID)))
      (if
 DontDisplay
	  then
 ID
	else
 (
SETQ
 Window (
CREATEW
 (
NC.DetermineDisplayRegion
 ID NIL)
				   (
NC.SetTitle
 ID (
OR
 Title "Untitled"))))
	     (
WINDOWPROP
 Window (
QUOTE
 NoteCardsLeftButtonMenu)
			 (
NC.MakeTEditLeftMenu
 (
NC.FetchType
 ID)))
	     (
WINDOWPROP
 Window (
QUOTE
 NoteCardsMiddleButtonMenu)
			 (
NC.MakeTEditMiddleMenu
))           (* Display the card)

	     (
WINDOWADDPROP
 Window (
QUOTE
 SHRINKFN)
			    (
FUNCTION
 NC.TextCardShrinkFn))
	     (
TEDIT
 TextStream Window NIL (
LIST
 (
QUOTE
 FONT)
						NC.DefaultFont
						(
QUOTE
 TITLEMENUFN)
						(
FUNCTION
 NC.TEditMenuFn)))
	     (until
 (
WINDOWPROP
 Window (
QUOTE
 TEXTSTREAM)) do
 (
BLOCK
))
	     (
NC.ActivateCard
 ID)
	     (if
 NC.AlphabetizedFileBoxChildrenFlg
		 then
 (
NCP.CardProp
 ID (
QUOTE
 OrderingFn)
				    (
FUNCTION
 NC.IDAlphOrder)))
	     (if
 (
GETPROMPTWINDOW
 Window NIL NIL T)
		 then
 (
PROG1
 (
DISMISS
 1000)
			     (
NC.ClearMsg
 Window T)))
	     Window))))

(NC.FileBoxCollectChildren

  (LAMBDA (WindowOrTextStream ID NewChildren NoDisplayFlg)   (* rht: "15-Feb-85 15:53")


          (* * Ask user for new children (either cards or fileboxes) for this filebox. Check to make sure that no 

	  circularities are introduced. This code is sort of the inverse of the NC.AddParents code and thus looks quite 

	  similar.)




          (* * rht 10/29/84: Added NoDisplayFlg to prevent error message when no appropriate elements exist.

	  Also now returns ID if at least one child was added, NIL otherwise.)



    (
PROG
 (Window ReturnVal)
          (
COND

	    (WindowOrTextStream (
SETQ
 Window (
WINDOW.FROM.TEDIT.THING
 WindowOrTextStream))))
          (
OR
 ID (
SETQ
 ID (
NC.IDFromWindow
 Window)))
          (
OR
 NewChildren (
SETQ
 NewChildren (
NC.SelectNoteCards
 NIL NIL 
								NC.SelectingFileBoxChildrenMenu ID 
								NIL " Please select new children.")))
          (
COND

	    ((
NULL
 (
AND
 NewChildren ID (for
 NewChildID in
 NewChildren bind
 OneHook
					  when
 (
NC.MakeChildLink
 NewChildID ID Window)
					  do
 (
SETQ
 OneHook T) finally
 (
RETURN
 OneHook))))
	      (
OR
 NoDisplayFlg (
NC.PrintMsg
 Window NIL 
					    "No appropriate NoteCards or FileBoxes chosen."
					    (
CHARACTER
 13)
					    "Hence no children added."
					    (
CHARACTER
 13)))
	      (
SETQ
 ReturnVal NIL))
	    (T (
SETQ
 ReturnVal ID)))
          (
AND
 Window (
GETPROMPTWINDOW
 Window NIL NIL T)
	       (
PROG1
 (
DISMISS
 1000)
		      (
NC.ClearMsg
 Window T)))
          (
RETURN
 ReturnVal))))
)
(DEFINEQ

(NC.AddFileBoxCard

  (LAMBDA NIL                                                (* fgh: "15-Feb-85 13:18")

    (
NC.AddCardType
 (
QUOTE
 FileBox)
		    (
QUOTE
 Text)
		    (
QUOTE
 TEXT)
		    (
BQUOTE
 ((MakeCardFn , (
FUNCTION
 NC.MakeContentsCard))))
		    (
BQUOTE
 ((LinkDisplayMode Title)
			     (CardDefaultHeight 200)
			     (CardDefaultWidth 335)
			     (CardDisplayedInMenuFlg , T))))))
)
(NC.AddFileBoxCard)
(PUTPROPS NCFILEBOXCARD COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1174 5624 (NC.ContentsCardP 1184 . 1626) (NC.MakeContentsCard 1628 . 3964) (
NC.FileBoxCollectChildren 3966 . 5622)) (5625 6060 (NC.AddFileBoxCard 5635 . 6058)))))
STOP