(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Oct-88 19:24:47" {QV}<NOTECARDS>1.3MNEXT>NCFILEBOXCARD.;1 10896
previous date%: "13-Aug-88 15:17:26" {QV}<NOTECARDS>1.3LNEXT>NCFILEBOXCARD.;5)
(* "
Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT NCFILEBOXCARDCOMS)
(RPAQQ NCFILEBOXCARDCOMS
([DECLARE%: DONTEVAL@LOAD FIRST (P (NC.LoadFileFromDirectories 'NCTEXTCARD]
(FNS NCAddStub.FileBoxCard)
(GLOBALVARS NC.FileBoxIcon NC.MarkersInFileBoxesFlg NC.SubBoxMarkerLabel
NC.FiledCardMarkerLabel NC.AlphabetizedFileBoxChildrenFlg)
(FNS NC.FileBoxP NC.MakeFileBox NC.FileBoxCollectChildren)
(FNS NC.AddFileBoxCard)
(BITMAPS NC.FileBoxIcon)
(DECLARE%: DONTEVAL@LOAD (P (NC.AddFileBoxCard)))
(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
NCFILEBOXCARD)))
(DECLARE%: DONTEVAL@LOAD FIRST
(NC.LoadFileFromDirectories 'NCTEXTCARD)
)
(DEFINEQ
(NCAddStub.FileBoxCard
(LAMBDA NIL (* ; "Edited 3-Dec-87 19:01 by rht:")
(* * kirk 18Jun86 Add the FileBox card stub)
(NC.AddCardTypeStub 'FileBox 'Text 'NCFILEBOXCARD NIL '((DisplayedInMenuFlg . T)
(LinkIconAttachedBitMap ,NC.FileBoxIcon))
)))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.FileBoxIcon NC.MarkersInFileBoxesFlg NC.SubBoxMarkerLabel NC.FiledCardMarkerLabel
NC.AlphabetizedFileBoxChildrenFlg)
)
(DEFINEQ
(NC.FileBoxP
(LAMBDA (Card NoMsgFlg) (* fgh%: "17-Nov-85 19:49")
(* Return T if ID is a CONTENTS card.)
(* * fgh |11/13/85| Updated to handle Card object.)
(OR (EQ 'FileBox (NC.RetrieveType Card))
(AND (NULL NoMsgFlg)
(PROGN (NC.PrintMsg NIL T (NC.RetrieveTitle Card)
" is not a FileBox. Please choose again."
(CHARACTER 13))
NIL)))))
(NC.MakeFileBox
[LAMBDA (Card Title NoDisplayFlg ParamList InterestedWindow RegionOrPosition)
(* ; "Edited 5-Aug-88 15:43 by Trigg")
(* ; "Make up a blank contents card, hook it to the user specified parent contents cards, and display it.")
(* ;; "rht 12/2/84: In NoDisplayFlg 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.")
(* ;; "fgh 11/13/85 Updated to handle Card object.")
(* ;; "fgh 2/6/86 Chaged calls to NC.FetchDefaultHeight & NC.FetchDefaultWidth")
(* ;; "fgh 2/6/86 Removed bug where NC.ClearMsg was deleteing card immediately.")
(* ;; "rht 4/11/86: Now passes Type and Window to NC.MakeTEditLeftMenu.")
(* ;; "rht 8/2/86: Now lets NC.MakeTEditPropsList build the props to be passed to TEDIT.")
(* ;;
"rht 9/8/86: Now doesn't create window before calling TEDIT to avoid stupid prompt win popping up.")
(* ;; "rht 9/19/86: Now applies supertype's MakeFn to cut out redundant code.")
(* ;; "rht 11/10/86: Now passes NIL as title to Super's makefn.")
(* ;; "rht 8/5/88: Added RegionOrPosition arg and passed to super's makefn. Also added ParamList and InterestedWindow args.")
(DECLARE (GLOBALVARS NC.MarkersInFileBoxesFlg NC.SubBoxMarkerLabel NC.FiledCardMarkerLabel
NC.AlphabetizedFileBoxChildrenFlg))
(LET ((Spacer (CONCAT (CHARACTER 13)
(CHARACTER 13)))
Window TextStream Type)
(SETQ Window (WINDOWP (NC.ApplySupersFn MakeFn Card NIL NoDisplayFlg
(if ParamList
then (LISTPUT ParamList 'Don'tAttachUserSpecifiedPropsFlg T
)
else '(Don'tAttachUserSpecifiedPropsFlg T))
InterestedWindow RegionOrPosition)))
(SETQ TextStream (NC.FetchSubstance Card))
(COND
(NC.MarkersInFileBoxesFlg (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)))
(if NC.AlphabetizedFileBoxChildrenFlg
then (NCP.CardProp Card 'OrderingFn (FUNCTION NC.IDAlphOrder)))
(if NoDisplayFlg
then Card
else Window])
(NC.FileBoxCollectChildren
[LAMBDA (WindowOrTextStream Card NewChildren NoDisplayFlg) (* Randy.Gobbel " 2-Apr-87 15:38")
(* * 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.)
(* * fgh |11/13/85| Updated to handle Card object.)
(* * rht 7/5/86%: Now checks for readonly cards.)
(* * rht 8/11/86%: Added code to check to make sure that another operation is
not in progress on this card when this fn is called.)
(* * rht 10/17/86%: Made successful filing operations NOT do dismiss.)
(* * pmi 12/5/86%: Modified message to NC.SelectNoteCards to mention
SHIFT-selection.)
(* * pmi 12/12/86%: Removed obsolete ReturnLinksFlg argument in call to
NC.SelectNoteCards.)
(* * rht 1/28/87%: Now activates parent box if necessary and saves before
deactivating.)
(* * rg |3/4/87| rewritten for new version of NC.ProtectedCardOperation)
(* * rg |3/18/87| added NC.CardSelectionOperation wrapper)
(OR Card (SETQ Card (NC.CoerceToCard WindowOrTextStream)))
(NC.ProtectedCardOperation
Card "Put Cards Here" NIL
(NCP.WithLockedCards (LET ((Window (NC.FetchWindow Card)))
(if (NC.CheckForNotReadOnly Card Window "Can't do filing in ")
then (OR NewChildren (SETQ NewChildren
(NC.SelectNoteCards NIL NIL
NC.SelectingFileBoxChildrenMenu Card
" Please shift-select new children.")
))
(COND
([AND NewChildren Card
(LET ((WasActiveFlg (NC.ActiveCardP Card)))
(OR WasActiveFlg (NC.GetNoteCard Card))
(PROG1 (for NewChild in NewChildren
bind OneHook
when (NC.MakeChildLink NewChild Card
Window)
do (SETQ OneHook T)
finally (RETURN OneHook))
(OR WasActiveFlg
(NC.QuitCard Card NIL NIL NIL NIL
NIL T]
Card)
((NULL NoDisplayFlg)
(NC.PrintMsg Window NIL
"No appropriate NoteCards or FileBoxes chosen."
(CHARACTER 13)
"Hence no children added."
(CHARACTER 13))
(DISMISS 1000)
(NC.ClearMsg Window T)
NIL)
(T NIL])
)
(DEFINEQ
(NC.AddFileBoxCard
(LAMBDA NIL (* ; "Edited 3-Dec-87 19:01 by rht:")
(* * fgh |2/17/86| Added attached bitmap field.)
(NC.AddCardType
'FileBox
'Text
`((MakeFn ,(FUNCTION NC.MakeFileBox)))
`((LinkDisplayMode Title)
(DefaultHeight 200)
(DefaultWidth 335)
(DisplayedInMenuFlg ,T)
(LinkIconAttachedBitMap ,NC.FileBoxIcon)
(LeftButtonMenuItems
,(for Item in (NC.GetCardTypeField LeftButtonMenuItems 'Text)
join (if (EQ (CAR Item)
'Insert% Link)
then (LIST NC.GlobalInsertLinkMenuItem '(|Put Cards Here| (FUNCTION
NC.FileBoxCollectChildren
)
"Collect new cards and file boxes into this FileBox."
))
else (LIST Item))))))))
)
(RPAQQ NC.FileBoxIcon #*(21 18)OOOOOH@@OOOOOH@@OOOOOH@@H@@@@H@@H@@@@H@@H@B@@H@@H@@@@H@@OOOOOH@@H@@@@H@@H@@@@H@@H@B@@H@@H@@@@H@@OOOOOH@@H@@@@H@@H@@@@H@@H@B@@H@@H@@@@H@@OOOOOH@@
)
(DECLARE%: DONTEVAL@LOAD
(NC.AddFileBoxCard)
)
(PUTPROPS NCFILEBOXCARD FILETYPE :TCOMPL)
(PUTPROPS NCFILEBOXCARD MAKEFILE-ENVIRONMENT (:PACKAGE "IL" :READTABLE "INTERLISP" :BASE 10))
(PUTPROPS NCFILEBOXCARD COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1015 1422 (NCAddStub.FileBoxCard 1025 . 1420)) (1601 9191 (NC.FileBoxP 1611 . 2169) (
NC.MakeFileBox 2171 . 5091) (NC.FileBoxCollectChildren 5093 . 9189)) (9192 10406 (NC.AddFileBoxCard
9202 . 10404)))))
STOP