(FILECREATED " 8-Jan-87 15:47:19" {QV}<NOTECARDS>1.3K>NEXT>NCCONTAINERCARD.;8 10427
changes to: (VARS NCCONTAINERCARDCOMS)
(FNS NC.AddContainerCard)
previous date: "22-Dec-86 12:28:58" {QV}<NOTECARDS>1.3K>NEXT>NCCONTAINERCARD.;7)
(* Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCCONTAINERCARDCOMS)
(RPAQQ NCCONTAINERCARDCOMS ((GLOBALVARS NC.ContainerIcon NC.SelectingContainerChildrenMenu)
(FILES NCFILEBOXCARD)
(BITMAPS NC.ContainerIcon)
(FNS NC.ContainerChildLinkP NC.ContainerCollectChildren
NC.ContainerMarkerCopyFn NC.ContainerMarkerDisplayFn
NC.ContainerMarkerGetFn NC.ContainerMarkerImageBoxFn NC.ContainerP
NC.ContainerPlaceMarker NC.MakeContainer NC.MakeContainerChildLink)
(FNS NC.AddContainerCard)
(ADDVARS (IMAGEOBJGETFNS (NC.ContainerMarkerGetFn)))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (NC.AddContainerCard)))
(FNS NCAddStub.ContainerCard)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.ContainerIcon NC.SelectingContainerChildrenMenu)
)
(FILESLOAD NCFILEBOXCARD)
(RPAQ NC.ContainerIcon (READBITMAP))
(21 18
"OOOOOH@@"
"OOOOOH@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@G@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"OOOOOH@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@G@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"OOOOOH@@")
(DEFINEQ
(NC.ContainerChildLinkP
[LAMBDA (Link) (* Randy.Gobbel "18-Dec-86 16:55")
(EQ (QUOTE Child)
(fetch (Link Label) of Link])
(NC.ContainerCollectChildren
[LAMBDA (WindowOrTextStream Card NewChildren NoDisplayFlg)
(* Randy.Gobbel "18-Dec-86 17:20")
(* * Ask user for new children for this container. This code originated from the NC.FileBoxCollectChildren code and
thus looks quite similar.)
(OR Card (SETQ Card (NC.CoerceToCard WindowOrTextStream)))
(LET ((Window (NC.FetchWindow Card))
(TextStream (NC.FetchSubstance Card))
OperationInProgress)
(if (NC.CheckForNotReadOnly Card Window "Can't make links in ")
then (if (SETQ OperationInProgress (NC.OperationInProgress Card))
then
(* * Another interaction operation is in progress on this card and we have to interact with the user.
Can't do.)
(NC.PrintOperationInProgressMsg Window "Put Cards Here"
OperationInProgress)
else (NC.ProtectedCardOperation Card Put% Cards% Here
(OR NewChildren
(SETQ NewChildren
(NC.SelectNoteCards NIL NIL
NC.SelectingFileBoxChildrenMenu
Card NIL
" Please shift-select new children.")))
(COND
((AND NewChildren Card
(for NewChild in NewChildren
bind OneHook
when (
NC.MakeContainerChildLink
NewChild Card Window)
do (SETQ OneHook T)
finally (RETURN OneHook)))
Card)
((NULL NoDisplayFlg)
(NC.PrintMsg Window NIL
"No appropriate NoteCards chosen."
(CHARACTER 13)
"Hence no children added."
(CHARACTER 13))
(DISMISS 2000)
(NC.ClearMsg Window T)
NIL)
(T NIL])
(NC.ContainerMarkerCopyFn
[LAMBDA (ImageObj) (* Randy.Gobbel "17-Dec-86 17:29")
(NC.ContainerPlaceMarker (IMAGEOBJPROP ImageObj (QUOTE OBJECTDATUM])
(NC.ContainerMarkerDisplayFn
[LAMBDA (ImageObj Stream) (* Randy.Gobbel "17-Dec-86 17:24")
(LET ((Label (IMAGEOBJPROP ImageObj (QUOTE OBJECTDATUM)))
(Scale (DSPSCALE NIL Stream))
(Font (FONTCREATE (QUOTE HELVETICA)
12
(QUOTE BOLD)
NIL Stream)))
(RELMOVETO (ITIMES Scale 3)
0 Stream)
(DSPFONT (PROG1 (DSPFONT Font Stream)
(PRIN1 Label Stream))
Stream])
(NC.ContainerMarkerGetFn
[LAMBDA (FileStream TextStream) (* Randy.Gobbel "17-Dec-86 17:27")
(NC.ContainerPlaceMarker (READ FileStream])
(NC.ContainerMarkerImageBoxFn
[LAMBDA (ImageObj Stream) (* Randy.Gobbel "17-Dec-86 17:30")
(LET ((Font (FONTCREATE (QUOTE HELVETICA)
12
(QUOTE BOLD)
NIL Stream))
(Label (IMAGEOBJPROP ImageObj (QUOTE OBJECTDATUM)))
(Scale (DSPSCALE NIL Stream)))
(create IMAGEBOX
XSIZE ← (IPLUS (TIMES 6 Scale)
(STRINGWIDTH Label Font))
YSIZE ← (IPLUS (TIMES 18 Scale)
(FONTPROP Font (QUOTE HEIGHT)))
YDESC ← (IPLUS (TIMES 3 Scale)
(FONTPROP Font (QUOTE DESCENT)))
XKERN ← 0])
(NC.ContainerP
[LAMBDA (Card NoMsgFlg) (* Randy.Gobbel "18-Dec-86 11:43")
(OR (EQ (QUOTE Container)
(NC.RetrieveType Card))
(AND (NULL NoMsgFlg)
(PROGN (NC.PrintMsg NIL T (NC.RetrieveTitle Card)
" is not a Container. Please choose again."
(CHARACTER 13))
NIL])
(NC.ContainerPlaceMarker
[LAMBDA (Label) (* Randy.Gobbel "17-Dec-86 17:29")
(IMAGEOBJCREATE Label (IMAGEFNSCREATE (FUNCTION NC.ContainerMarkerDisplayFn)
(FUNCTION NC.ContainerMarkerImageBoxFn)
(FUNCTION NC.PlaceMarkerPutFn)
(FUNCTION NC.ContainerMarkerGetFn)
(FUNCTION NC.ContainerMarkerCopyFn)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL])
(NC.MakeContainer
[LAMBDA (Card Title NoDisplayFlg ParamList) (* Randy.Gobbel "18-Dec-86 11:45")
(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))
(TEDIT.INSERT.OBJECT (NC.ContainerPlaceMarker "Filed Cards-")
TextStream 1)
(TEDIT.INSERT TextStream Spacer 2)
(if NoDisplayFlg
then Card
else Window])
(NC.MakeContainerChildLink
[LAMBDA (NewChild Card Window) (* Randy.Gobbel "18-Dec-86 18:20")
(* * Try to add Child link from Card to NewChild. Disallow if this would cause a cycle. Returns new link if
successful, else NIL.)
(LET ((TextStream (NC.FetchSubstance Card)))
(COND
((NC.EnsureNoCycles Card NewChild (FUNCTION NC.ContainerChildLinkP)
Window)
(PROG1 (NC.InsertLinkInText TextStream (QUOTE Child)
NewChild Card NIL (GETEOFPTR TextStream))
(TEDIT.INSERT TextStream (CHARACTER 13])
)
(DEFINEQ
(NC.AddContainerCard
[LAMBDA NIL (* Randy.Gobbel " 8-Jan-87 15:45")
(DECLARE (GLOBALVARS NC.GlobalInsertLinkMenuItem NC.SelectingContainerChildrenMenu
NC.MainMenuPosition))
(* * Child type links are checked for cycles, and are equivalent to FiledCard and SubBox links when checking
whether cards are filed.)
(LET [(Font (FONTCREATE (QUOTE HELVETICA)
12
(QUOTE BOLD)))
(TitleFont (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE BOLD)))
(Position (OR (POSITIONP NC.MainMenuPosition)
(create POSITION
XCOORD ← 350
YCOORD ← 650]
(SETQ NC.SelectingContainerChildrenMenu (create MENU
ITEMS ← (QUOTE ((Cancel NIL
"Cancel this operation.")
(Undo NIL
"Backup over last selection.")
(Done NIL
"Indicates that this operation is completed.")))
WHENSELECTEDFN ← (FUNCTION
NC.SelectionMenusWhenSelectedFn)
TITLE ← "Selecting cards to file"
CENTERFLG ← T
MENUBORDERSIZE ← 1
MENUOUTLINESIZE ← 1
MENUCOLUMNS ← 3
MENUFONT ← Font
ITEMHEIGHT ← (IPLUS
10
(FONTPROP Font (QUOTE HEIGHT)))
MENUPOSITION ← Position
MENUTITLEFONT ← TitleFont))
(PUTPROP (QUOTE Child)
(QUOTE FilingLinkTypeFlg)
T)
(NC.AddCardType (QUOTE Container)
(QUOTE Text)
[BQUOTE ((MakeFn , (FUNCTION NC.MakeContainer]
(BQUOTE
((LinkDisplayMode Title)
(DefaultHeight 200)
(DefaultWidth 335)
(DisplayedInMenuFlg , T)
(LinkIconAttachedBitMap , NC.ContainerIcon)
(LeftButtonMenuItems
,
(for Item in (NC.GetCardTypeField LeftButtonMenuItems
(QUOTE Text))
join (if (EQ (CAR Item)
(QUOTE Insert% Link))
then (LIST Item
(QUOTE (Put% Cards% Here
(FUNCTION
NC.ContainerCollectChildren)
"Collect new cards into this Container.")))
else (LIST Item])
)
(ADDTOVAR IMAGEOBJGETFNS (NC.ContainerMarkerGetFn))
(DECLARE: DONTEVAL@LOAD DOCOPY
(NC.AddContainerCard)
)
(DEFINEQ
(NCAddStub.ContainerCard
[LAMBDA NIL (* Randy.Gobbel "22-Dec-86 12:28")
(NC.AddCardTypeStub (QUOTE Container)
(QUOTE Text)
(QUOTE NCCONTAINERCARD)
NIL
(QUOTE ((DisplayedInMenuFlg . T)
(LinkIconAttachedBitMap , NC.ContainerIcon])
)
(PUTPROPS NCCONTAINERCARD COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1387 7507 (NC.ContainerChildLinkP 1397 . 1595) (NC.ContainerCollectChildren 1597 . 3523
) (NC.ContainerMarkerCopyFn 3525 . 3739) (NC.ContainerMarkerDisplayFn 3741 . 4259) (
NC.ContainerMarkerGetFn 4261 . 4445) (NC.ContainerMarkerImageBoxFn 4447 . 5110) (NC.ContainerP 5112 .
5487) (NC.ContainerPlaceMarker 5489 . 6068) (NC.MakeContainer 6070 . 6868) (NC.MakeContainerChildLink
6870 . 7505)) (7508 9872 (NC.AddContainerCard 7518 . 9870)) (9986 10336 (NCAddStub.ContainerCard 9996
. 10334)))))
STOP