(FILECREATED "24-Apr-87 14:33:37" {QV}<NOTECARDS>1.3K>NEXT>NCFILEBOXCARD.;33 8896
changes to: (VARS NCFILEBOXCARDCOMS)
previous date: " 5-Apr-87 19:54:41" {QV}<NOTECARDS>1.3K>NEXT>NCFILEBOXCARD.;31)
(* Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCFILEBOXCARDCOMS)
(RPAQQ NCFILEBOXCARDCOMS ((GLOBALVARS NC.FileBoxIcon NC.MarkersInFileBoxesFlg NC.SubBoxMarkerLabel
NC.FiledCardMarkerLabel NC.AlphabetizedFileBoxChildrenFlg)
[DECLARE: COPY FIRST (P (NC.LoadFileFromDirectories (QUOTE NCTEXTCARD]
(FNS NC.FileBoxP NC.MakeFileBox NC.FileBoxCollectChildren)
(FNS NC.AddFileBoxCard)
(BITMAPS NC.FileBoxIcon)
(P (NC.AddFileBoxCard))
(FNS NCAddStub.FileBoxCard)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.FileBoxIcon NC.MarkersInFileBoxesFlg NC.SubBoxMarkerLabel NC.FiledCardMarkerLabel
NC.AlphabetizedFileBoxChildrenFlg)
)
(DECLARE: COPY FIRST
(NC.LoadFileFromDirectories (QUOTE NCTEXTCARD))
)
(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 (QUOTE 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) (* rht: "10-Nov-86 22:49")
(* 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.)
(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 (QUOTE
Don'tAttachUserSpecifiedPropsFlg)
T)
else (QUOTE (
Don'tAttachUserSpecifiedPropsFlg T]
(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 (QUOTE 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 (* rht: " 7-Apr-86 18:21")
(* * fgh 2/17/86 Added attached bitmap field.)
(NC.AddCardType (QUOTE FileBox)
(QUOTE Text)
(BQUOTE ((MakeFn , (FUNCTION NC.MakeFileBox))))
(BQUOTE ((LinkDisplayMode Title)
(DefaultHeight 200)
(DefaultWidth 335)
(DisplayedInMenuFlg , T)
(LinkIconAttachedBitMap , NC.FileBoxIcon)
(LeftButtonMenuItems
,
(for Item in (NC.GetCardTypeField LeftButtonMenuItems
(QUOTE Text))
join (if (EQ (CAR Item)
(QUOTE Insert% Link))
then (LIST NC.GlobalInsertLinkMenuItem
(QUOTE
(Put% Cards% Here
(FUNCTION
NC.FileBoxCollectChildren)
"Collect new cards and file boxes into this FileBox.")))
else (LIST Item)))))))))
)
(RPAQ NC.FileBoxIcon (READBITMAP))
(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@@")
(NC.AddFileBoxCard)
(DEFINEQ
(NCAddStub.FileBoxCard
(LAMBDA NIL (* kirk: "10-Sep-86 13:53")
(* * kirk 18Jun86 Add the FileBox card stub)
(NC.AddCardTypeStub (QUOTE FileBox)
(QUOTE Text)
(QUOTE NCFILEBOXCARD)
NIL
(QUOTE ((DisplayedInMenuFlg . T)
(LinkIconAttachedBitMap , NC.FileBoxIcon))))))
)
(PUTPROPS NCFILEBOXCARD COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1030 7134 (NC.FileBoxP 1040 . 1575) (NC.MakeFileBox 1577 . 4121) (
NC.FileBoxCollectChildren 4123 . 7132)) (7135 8138 (NC.AddFileBoxCard 7145 . 8136)) (8401 8802 (
NCAddStub.FileBoxCard 8411 . 8800)))))
STOP