(FILECREATED "25-Aug-86 21:31:07" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH094.;3 27252
changes to: (FNS NCP.CardTypeVar NCP.CardTypeFn NC.LinkIconDisplayFn NC.LinkIconImageBoxFn)
(VARS RHTPATCH094COMS)
previous date: "25-Aug-86 17:01:52" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH094.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH094COMS)
(RPAQQ RHTPATCH094COMS ((* * Changes to NCPROGINT)
(FNS NCP.MakeDocument NCP.CardSubstance NCP.CardRegion NCP.CardAddText
NCP.LocalGlobalLink NCP.LinkDisplayMode NCP.LinkType NCP.CardDates
NCP.LinkAnchorDesc NCP.CardTypeVar NCP.CardTypeFn)
(* * Changes to NCLINKS)
(FNS NC.LinkIconDisplayFn NC.LinkIconImageBoxFn)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA NCP.LinkType NCP.LinkDisplayMode NCP.CardSubstance)
))))
(* * Changes to NCPROGINT)
(DEFINEQ
(NCP.MakeDocument
(LAMBDA (NoteFile RootCard ParamProps NoDisplayFlg Props ParentFileBoxes)
(* rht: "25-Aug-86 16:57")
(* * Do a MakeDocument starting from RootCard according to parameters in ParamProps if non-nil.
Otherwise use the default parameters. Note that ParamProps are *only* used for the duration of this MakeDocument
and do not affect the default parameter values.)
(* * rht 11/17/85: Updated to handle new card and notefile objects.)
(* * rht 8/25/86: Now passes non-nil QuietFlg to NCP.UncacheCards.)
(LET (CurParams DocCard WasActive)
(if (NC.ValidCardP RootCard)
then (AND (NOT (SETQ WasActive (NCP.CardCachedP RootCard)))
(NCP.CacheCards RootCard))
(if ParamProps
then (SETQ CurParams (NCP.DocumentParameters ParamProps)))
(SETQ DocCard (NCP.CreateCard (QUOTE Document)
NoteFile NIL NoDisplayFlg Props ParentFileBoxes
RootCard))
(if ParamProps
then (SETPROPLIST (QUOTE NC.MakeDocParameters)
CurParams))
(AND (NOT WasActive)
(NCP.UncacheCards RootCard T))
DocCard
else (NCP.ReportError RootCard " not a valid card or filebox.")
NIL))))
(NCP.CardSubstance
(LAMBDA Args (* rht: "25-Aug-86 16:52")
(* * Return the substance for this card.)
(* * rht 11/17/85: Updated to handle new card and notefile objects.)
(* * rht 8/8/86: Now can accept one or two args. Always returns old substance, but will replace substance with
second arg if present.)
(* * 8/25/86: Now passes non-nil QuietFlg to NCP.CloseCards.)
(LET (Card)
(COND
((AND (NEQ Args 1)
(NEQ Args 2))
(NCP.ReportError "Improper number of args to NCP.CardSubstance.")
NIL)
((NCP.ValidCardP (SETQ Card (ARG Args 1)))
(LET (WasActive)
(OR (SETQ WasActive (NCP.CardCachedP Card))
(NCP.CacheCards Card))
(PROG1 (NC.FetchSubstance Card)
(if (EQ Args 2)
then (NC.SetSubstance Card (ARG Args 2))
(NCP.MarkCardDirty Card))
(OR WasActive (NCP.CloseCards Card T)))))
(T (NCP.ReportError Card " not an existing card.")
NIL)))))
(NCP.CardRegion
(LAMBDA (Card) (* rht: "25-Aug-86 16:57")
(* * Return the substance for this card.)
(* * rht 11/17/85: Updated to handle new card and notefile objects.)
(* * rht 8/25/86: Now passes non-nil QuietFlg to NCP.UncacheCards.)
(if (NC.ValidCardP Card)
then (LET (WasActive)
(OR (SETQ WasActive (NCP.CardCachedP Card))
(NCP.CacheCards Card))
(PROG1 (NC.FetchRegion Card)
(OR WasActive (NCP.UncacheCards Card T))))
else (NCP.ReportError Card " not an existing card.")
NIL)))
(NCP.CardAddText
(LAMBDA (Card Text Loc) (* rht: "25-Aug-86 16:58")
(* * Adds the Text to ID's window at the given Loc. Loc defaults to the current cursor position.)
(* * rht 11/17/85: Updated to handle new card and notefile objects.)
(* * rht 8/25/86: Now passes non-nil QuietFlg to NCP.UncacheCards.)
(PROG (WasActiveP)
(if (NOT (NC.ValidCardP Card))
then (NCP.ReportError Card " is not an existing card or filebox.")
(RETURN NIL))
(if (NOT (NCP.TextBasedP (NCP.CardType Card)))
then (NCP.ReportError "Can only add text to cards with type Text.")
(RETURN NIL))
(if (NOT (SETQ WasActiveP (NCP.CardCachedP Card)))
then (NCP.CacheCards Card))
(NCP.ChangeLoc Card Loc)
(TEDIT.INSERT (NC.FetchSubstance Card)
Text)
(NC.MarkCardDirty Card)
(if (NOT WasActiveP)
then (NCP.UncacheCards Card T))
(RETURN Card))))
(NCP.LocalGlobalLink
(LAMBDA (LinkType SourceCard DestinationCard FromLoc DisplayMode)
(* rht: "25-Aug-86 16:59")
(* * Create a link from within the text of the SourceCard card to the DestinationCard card.)
(* * rht 4/1/85: Changed to handle old-style link display modes.)
(* * rht 11/17/85: Updated to handle new card and notefile objects.)
(* * rht 8/25/86: Now passes non-nil QuietFlg to NCP.UncacheCards.)
(PROG ((CoercedDisplayMode (NCP.CoerceToLinkDisplayMode (OR DisplayMode (NCP.CardType
SourceCard))))
WasActive NoteFile)
(if (NULL CoercedDisplayMode)
then (NCP.ReportError DisplayMode " is invalid link display mode." (CHARACTER
13)
"No link created.")
(RETURN NIL))
(if (EQ LinkType NC.FiledCardLinkLabel)
then (if (AND (NOT (NCP.FileBoxP DestinationCard))
(NCP.FileBoxP SourceCard))
then (OR (SETQ WasActive (NCP.CardCachedP SourceCard))
(NCP.CacheCards SourceCard))
(NCP.ChangeLoc SourceCard FromLoc)
(NCP.FileCards DestinationCard SourceCard)
(RETURN (PROG1 (CAR (NCP.GetLinks SourceCard
DestinationCard
NC.FiledCardLinkLabel))
(OR WasActive (NCP.UncacheCards SourceCard T)
)))
else (NCP.ReportError "FiledCard link must be from a box to a card."
(CHARACTER 13)
"No link created.")
(RETURN NIL)))
(if (EQ LinkType NC.SubBoxLinkLabel)
then (if (AND (NCP.FileBoxP DestinationCard)
(NCP.FileBoxP SourceCard))
then (OR (SETQ WasActive (NCP.CardCachedP SourceCard))
(NCP.CacheCards SourceCard))
(NCP.ChangeLoc SourceCard FromLoc)
(NCP.FileCards DestinationCard SourceCard)
(RETURN (PROG1 (CAR (NCP.GetLinks SourceCard
DestinationCard
NC.SubBoxLinkLabel))
(OR WasActive (NCP.UncacheCards SourceCard T)
)))
else (NCP.ReportError "SubBox link must be from a box to a box."
(CHARACTER 13)
"No link created.")
(RETURN NIL))) (* Inserting non-hierarchical link into a filebox.)
(if (NCP.FileBoxP SourceCard)
then (NCP.ReportError
"Local links from fileboxes must be either SubBox or FiledCard."
(CHARACTER 13)
"No link created.")
(RETURN NIL))
(if (NOT (FMEMB LinkType (NCP.LinkTypes (SETQ NoteFile (fetch (Card NoteFile)
of SourceCard)))))
then (if (NC.AskYesOrNo (CONCAT
"That link type hasn't been used in NoteFile "
(fetch (NoteFile FullFileName)
of NoteFile)
(CHARACTER 13)
"Want to create a new link type: " LinkType
"? ")
"--" NIL T (NC.AttachPromptWindow
(WFROMMENU (fetch (NoteFile Menu) of NoteFile)))
NIL NIL)
then (NCP.CreateLinkType LinkType NoteFile)
else (RETURN NIL)))
(OR (SETQ WasActive (NCP.CardCachedP SourceCard))
(NCP.CacheCards SourceCard))
(AND FromLoc (NCP.ChangeLoc SourceCard FromLoc))
(RETURN (PROG1 (NC.InsertLinkInText (NC.FetchSubstance SourceCard)
LinkType DestinationCard SourceCard
CoercedDisplayMode)
(OR WasActive (NCP.UncacheCards SourceCard T)))))))
(NCP.LinkDisplayMode
(LAMBDA Args (* rht: "25-Aug-86 16:59")
(* * Takes either 1 or 2 args. The first is a link, the second an optional new link display mode.
Return old display mode in any case; change mode if the second arg is present.)
(* * rht 7/12/86: Now takes a list of three elements for new displaymode rather than an instance of the
LINKDISPLAYMODE record. Also calls NCP.CoerceToLinkDisplayMode.)
(* * rht 8/25/86: Now passes non-nil QuietFlg to NCP.UncacheCards.)
(LET (Link NewMode WasActiveFlg SourceCard)
(COND
((AND (NEQ Args 1)
(NEQ Args 2))
(NCP.ReportError "Improper number of args to NCP.LinkDisplayMode.")
NIL)
((NCP.ValidLink (SETQ Link (ARG Args 1)))
(PROG1 (fetch (Link DisplayMode) of Link)
(if (EQ Args 2)
then (if (SETQ NewMode (NCP.CoerceToLinkDisplayMode (ARG Args 2)))
then (OR (SETQ WasActiveFlg (NCP.CardCachedP
(SETQ SourceCard (fetch (Link SourceCard)
of Link))))
(NCP.CacheCards SourceCard))
(NC.ChangeLinkDisplayMode Link NIL NewMode)
(OR WasActiveFlg (NCP.UncacheCards SourceCard T))
else (NCP.ReportError (ARG Args 2)
" is invalid link display mode.")))))
(T (NCP.ReportError Link " is not a valid link.")
NIL)))))
(NCP.LinkType
(LAMBDA Args (* rht: "25-Aug-86 16:56")
(* * Takes either 1 or 2 args. The first is a link, the second an optional new label. Return old label in any case;
change label if the second arg is present.)
(* * rht 2/8/85: Now makes sure source card of link is active before calling NC.RelabelLink.)
(* * rht 8/25/86: Now passes non-nil QuietFlg to NCP.UncacheCards.)
(LET (Link NewLinkType SourceCard NoteFile)
(COND
((AND (NEQ Args 1)
(NEQ Args 2))
(NCP.ReportError "Improper number of args to NCP.LinkLabel.")
NIL)
((NCP.ValidLink (SETQ Link (ARG Args 1)))
(PROG1 (fetch (Link Label)
Link)
(if (EQ Args 2)
then (COND
((FMEMB (SETQ NewLinkType (ARG Args 2))
NC.SystemLinkLabels)
(NCP.ReportError "Can't change label to a system label: "
NewLinkType))
((OR (FMEMB NewLinkType (NCP.LinkTypes
(SETQ NoteFile (fetch (Card NoteFile)
of (SETQ SourceCard
(fetch
(Link SourceCard)
of Link))))))
(AND (NC.AskYesOrNo (CONCAT
"That link type hasn't been used in this NoteFile."
(CHARACTER 13)
"Want to create a new link type: "
NewLinkType "? ")
"--" NIL T NIL NIL NIL)
(NCP.CreateLinkType NewLinkType NoteFile)))
(if (NCP.CardCachedP SourceCard)
then (NC.RelabelLink Link NIL NewLinkType T)
else (NCP.CacheCards SourceCard)
(NC.RelabelLink Link NIL NewLinkType T)
(NCP.UncacheCards SourceCard T)))))))
(T (NCP.ReportError Link " is not a valid link.")
NIL)))))
(NCP.CardDates
(LAMBDA (Card) (* rht: "25-Aug-86 16:59")
(* * Returns an instance of the NOTECARDDATES record filled in with the current dates of the card parts of Card.)
(* * rht 8/25/86: Now passes non-nil QuietFlg to NCP.UncacheCards.)
(if (NC.ValidCardP Card)
then (LET ((WasActive (NCP.CardCachedP Card)))
(OR WasActive (NCP.CacheCards Card))
(PROG1 (create NOTECARDDATES
SUBSTANCEDATE ←(NC.FetchItemDate Card)
LINKSDATE ←(NC.FetchLinksDate Card)
TITLEDATE ←(NC.FetchTitleDate Card)
PROPLISTDATE ←(NC.FetchPropListDate Card))
(OR WasActive (NCP.UncacheCards Card T))))
else (NCP.ReportError Card " not an existing card.")
NIL)))
(NCP.LinkAnchorDesc
(LAMBDA (Link ToFlg) (* rht: "25-Aug-86 17:00")
(* * Return a description of the anchoring of Link at one of its endpoints. The description has the form
(<anchormode> <ID> <loc>) If ToFlg is non-nil, then look at the "To" end of the link, otherwise, its "From" end.)
(* * rht 8/25/86: Now passes non-nil QuietFlg to NCP.UncacheCards.)
(PROG (Card WasActiveP)
(SETQ Card (if ToFlg
then (fetch (Link DestinationCard) of Link)
else (fetch (Link SourceCard) of Link)))
(RETURN (COND
((OR (NC.GlobalLinkP Link)
ToFlg)
(LIST (QUOTE GLOBAL)
Card NIL))
(T (COND
((NOT (SETQ WasActiveP (NCP.CardCachedP Card)))
(NCP.CacheCards Card)))
(for Obj in (CAR (NC.CollectReferences Card NIL NIL T))
when (NC.SameLinkP Link (CAR Obj))
do (COND
((NOT WasActiveP)
(NCP.UncacheCards Card T)))
(RETURN (LIST (QUOTE LOCAL)
Card
(CDR Obj))))))))))
(NCP.CardTypeVar
(LAMBDA (TypeName Var) (* rht: "25-Aug-86 21:30")
(* * Return the variable stored as the Var for TypeName's record.)
(* * kirk 26Feb86 Replaced NIL DEC in RECORDACCESS call with RECLOOK)
(* * rht 8/25/86: Changed RECORDACCESS to slightly less scuzzy call to NC.GetCardTypeField, the advantage is that
the latter will force autoload if necessary.)
(if (NCP.CardTypeP TypeName)
then (if (NCP.ValidCardTypeVar Var)
then (EVAL (BQUOTE (NC.GetCardTypeField , Var TypeName)))
else (NCP.ReportError Var " is not a kind of Var for NoteCard types."))
else (NCP.ReportError TypeName " is not a loaded NoteCard type.")
NIL)))
(NCP.CardTypeFn
(LAMBDA (TypeName Fn) (* rht: "25-Aug-86 21:30")
(* * Return the function stored as the Fn for TypeName's record.)
(* * rht 7/7/86: Replaced NIL DEC in RECORDACCESS call with RECLOOK)
(* * rht 8/25/86: Changed RECORDACCESS to slightly less scuzzy call to NC.GetCardTypeField, the advantage is that
the latter will force autoload if necessary.)
(if (NCP.CardTypeP TypeName)
then (if (NCP.ValidCardTypeFn Fn)
then (EVAL (BQUOTE (NC.GetCardTypeField , Fn TypeName)))
else (NCP.ReportError Fn " is not a kind of Fn for NoteCard types."))
else (NCP.ReportError TypeName " is not a loaded NoteCard type.")
NIL)))
)
(* * Changes to NCLINKS)
(DEFINEQ
(NC.LinkIconDisplayFn
(LAMBDA (ImageObj ImageStream STREAMTYPE TEXTSTREAM SCALE)
(* rht: "25-Aug-86 17:07")
(* * Display a link icon)
(* * rht 11/13/84: Made width of box lines also scale dependent.)
(* * rht 12/4/84: Hacked so type-dependent icons come out optionally to left of text.)
(* * rht 2/9/85: Changed to use new display mode format.)
(* * fgh 2/5/86 Added call to NC.FetchLinkIconAttachedBitMap)
(* * rht & fgh 5/9/86: Massive hacking to display coords, etc.)
(* * fgh 5/9/86 Added DSPFONT kludge after TypeIcon BITBLT to get around bug in PRESS BITBLT.
Bug reported as AR #5630.0)
(* * rht 5/10/86: Rearranged order of expressions a bit and added arg to call to NC.FetchLinkIconAttachedBitMap in
order to get a bitmap with correct height for the box we're drawing.)
(* * rht 8/7/86: Now passes Scale argument to NC.FetchLinkIconAttachedBitMap. Also uses the Title and Label args if
non-nil. If not, then recomputes them more sensibly.)
(* * rht 8/25/85: Fixed improperly placed comment.)
(RESETLST (RESETSAVE NIL (BQUOTE (DSPFONT , (DSPFONT NC.LinkIconFont ImageStream)
, ImageStream)))
(PROG ((Scale (DSPSCALE NIL ImageStream))
(Link (NC.FetchLinkFromLinkIcon ImageObj))
Font Left Bottom ShowTitleFlg LinkDisplayMode AttachBitmapFlg DisplayType
Window Card Title Label BoxWidth BoxHeight ImageBox TypeIcon
ScaledBitmapWidth ScaledBorderWidth ScaledSpaceInnerX ScaledSpaceOuterX
ScaledSpaceOuterY)
(SETQ Font (DSPFONT NIL ImageStream))
(* * Determine what type of Display to do)
(SETQ DisplayType (fetch (Link DisplayMode) of Link))
(SETQ Card (if (EQ (SETQ ShowTitleFlg (fetch (LINKDISPLAYMODE
SHOWTITLEFLG)
of DisplayType))
(QUOTE SOURCE))
then (fetch (Link SourceCard) of Link)
else (fetch (Link DestinationCard) of Link)))
(SETQ LinkDisplayMode (fetch (LINKDISPLAYMODE SHOWLINKTYPEFLG)
of DisplayType))
(SETQ AttachBitmapFlg (fetch (LINKDISPLAYMODE ATTACHBITMAPFLG)
of DisplayType))
(SETQ Title (if (AND ShowTitleFlg (OR (NEQ ShowTitleFlg
(QUOTE FLOAT))
NC.LinkIconShowTitleFlg))
then (NC.RetrieveTitle Card)
else NIL))
(SETQ Label (AND (COND
((EQ LinkDisplayMode (QUOTE FLOAT))
NC.LinkIconShowLinkTypeFlg)
(T LinkDisplayMode))
(fetch (Link Label) of Link)))
(* * Get the image box info for this icon)
(SETQ ImageBox (OR (IMAGEOBJPROP ImageObj (QUOTE BOUNDBOX))
(NC.LinkIconImageBoxFn ImageObj ImageStream NIL NIL
NIL DisplayType Title Label)))
(* * Make temporaries of scaled vars.)
(SETQ ScaledBorderWidth (TIMES Scale NC.LinkIconBorderWidth))
(SETQ ScaledSpaceInnerX (TIMES Scale NC.LinkIconSpaceInnerX))
(SETQ ScaledSpaceOuterX (TIMES Scale NC.LinkIconSpaceOuterX))
(SETQ ScaledSpaceOuterY (TIMES Scale NC.LinkIconSpaceOuterY))
(* * Compute all the size values.)
(SETQ Bottom (PLUS (DIFFERENCE (DSPYPOSITION NIL ImageStream)
(fetch (IMAGEBOX YDESC)
of ImageBox))
ScaledSpaceOuterY))
(SETQ BoxHeight (DIFFERENCE (fetch (IMAGEBOX YSIZE) of ImageBox)
(PLUS ScaledSpaceOuterY ScaledSpaceOuterY)))
(* * The adding of Scale to BoxHeight in the call to NC.FetchLinkIconAttachedBitMap is a kludge that works.
Just BoxHeight would make alot more sense.)
(SETQ TypeIcon (AND (COND
((EQ AttachBitmapFlg (QUOTE FLOAT))
NC.LinkIconAttachBitmapFlg)
(T AttachBitmapFlg))
(NC.FetchLinkIconAttachedBitMap Card
(PLUS Scale
BoxHeight)
Scale)))
(SETQ ScaledBitmapWidth (if TypeIcon
then (TIMES Scale (BITMAPWIDTH TypeIcon))
else 0))
(SETQ Left (PLUS (DSPXPOSITION NIL ImageStream)
ScaledSpaceOuterX))
(SETQ BoxWidth (DIFFERENCE (fetch (IMAGEBOX XSIZE) of ImageBox)
(PLUS ScaledSpaceOuterX ScaledSpaceOuterX
ScaledBitmapWidth)))
(* * Put out the icon bitmap for the appropriate type.)
(COND
(TypeIcon (BITBLT TypeIcon 0 0 ImageStream Left Bottom)
(* DSPFONT is a kludge to get around bug in PRESS BITBLT which sets the width of a space char to NIL.
Bug reported as AR #5630.0)
(DSPFONT Font ImageStream)))
(if (AND TypeIcon (NOT (OR Label Title)))
then (* Quit because just a typeicon)
(RETURN))
(* * Enter the appropriate text.)
(DSPXPOSITION (PLUS Left (if TypeIcon
then ScaledBitmapWidth
else ScaledBorderWidth)
ScaledSpaceInnerX)
ImageStream)
(DSPYPOSITION (PLUS Bottom ScaledBorderWidth (TIMES Scale
NC.LinkIconSpaceInnerY)
(FONTDESCENT Font))
ImageStream)
(if (OR Label Title)
then (PRIN1 " " ImageStream))
(AND Label (PRIN1 (CONCAT "<" Label ">")
ImageStream))
(AND Label Title (PRIN1 " " ImageStream))
(AND Title (PRIN1 Title ImageStream))
(* * Draw the box.)
(NC.DrawInnerBox (PLUS Left ScaledBitmapWidth)
Bottom BoxWidth BoxHeight ScaledBorderWidth NIL
ImageStream TypeIcon)))))
(NC.LinkIconImageBoxFn
(LAMBDA (ImageObj ImageStream CurrentX RightMargin DummyArg DisplayType Title Label)
(* rht: "25-Aug-86 17:07")
(* * rht 9/20/84: Now scales result before returning by proper amount depending on stream type.
e.g. for PRESS and INTERPRESS.)
(* * rht 11/13/84: In computation of XSIZE, extra width is figured using characters in the font, "nn", rather than
absolute pixel count.)
(* * rht 2/9/85: Now uses new displaymode format.)
(* * rht 5/9/86: Note that RightMargin non-nil signals a TEdit stream.)
(* * rht & fgh 5/9/86: Massive hacking to display coords, etc.)
(* * rht 5/10/86: Rearranged order of expressions a bit and added arg to call to NC.FetchLinkIconAttachedBitMap in
order to get a bitmap with correct height for the box we're drawing.)
(* * rht 8/7/86: Now passes Scale argument to NC.FetchLinkIconAttachedBitMap. Also uses the Title and Label args if
non-nil. If not, then recomputes them more sensibly.)
(* * rht 8/25/85: Fixed improperly placed comment.)
(LET ((Link (NC.FetchLinkFromLinkIcon ImageObj))
(Scale (DSPSCALE NIL ImageStream))
Card FONT TypeIcon Label Title ShowTitleFlg AttachBitmapFlg LinkDisplayMode StringWidth
YSize)
(RESETLST (RESETSAVE NIL (BQUOTE (DSPFONT , (DSPFONT NC.LinkIconFont ImageStream)
, ImageStream)))
(SETQ FONT (DSPFONT NIL ImageStream)))
(OR DisplayType (SETQ DisplayType (fetch (Link DisplayMode) of Link)))
(SETQ Card (if (EQ (SETQ ShowTitleFlg (fetch (LINKDISPLAYMODE SHOWTITLEFLG)
of DisplayType))
(QUOTE SOURCE))
then (fetch (Link SourceCard) of Link)
else (fetch (Link DestinationCard) of Link)))
(SETQ LinkDisplayMode (fetch (LINKDISPLAYMODE SHOWLINKTYPEFLG) of DisplayType))
(SETQ AttachBitmapFlg (fetch (LINKDISPLAYMODE ATTACHBITMAPFLG) of DisplayType))
(OR Title (SETQ Title (if (AND ShowTitleFlg (OR (NEQ ShowTitleFlg (QUOTE
FLOAT))
NC.LinkIconShowTitleFlg))
then (NC.RetrieveTitle Card)
else NIL)))
(OR Label (SETQ Label (AND (COND
((EQ LinkDisplayMode (QUOTE FLOAT))
NC.LinkIconShowLinkTypeFlg)
(T LinkDisplayMode))
(fetch (Link Label) of Link))))
(SETQ TotalEdgeSpaceY (TIMES Scale (PLUS NC.LinkIconBorderWidth NC.LinkIconSpaceOuterY
NC.LinkIconSpaceInnerY)))
(SETQ YSize (PLUS TotalEdgeSpaceY TotalEdgeSpaceY (FONTHEIGHT FONT)))
(* * The adding of Scale to BoxHeight in the call to NC.FetchLinkIconAttachedBitMap is a kludge that works.
Just BoxHeight would make alot more sense.)
(SETQ TypeIcon (AND (COND
((EQ AttachBitmapFlg (QUOTE FLOAT))
NC.LinkIconAttachBitmapFlg)
(T AttachBitmapFlg))
(NC.FetchLinkIconAttachedBitMap Card
(PLUS Scale
(DIFFERENCE
YSize
(PLUS
NC.LinkIconSpaceOuterY
NC.LinkIconSpaceOuterY)))
Scale)))
(SETQ StringWidth (COND
((OR Label Title)
(STRINGWIDTH (CONCAT " " (COND
(Label (CONCAT "<" Label ">"))
(T ""))
(COND
((AND Label Title)
" ")
(T ""))
(OR Title ""))
FONT))
((NOT TypeIcon)
(STRINGWIDTH " " FONT))
(T 0)))
(create IMAGEBOX
XSIZE ←(PLUS StringWidth (TIMES Scale 2 (PLUS NC.LinkIconSpaceOuterX
NC.LinkIconSpaceInnerX))
(TIMES Scale (if TypeIcon
then (PLUS NC.LinkIconBorderWidth
(BITMAPWIDTH TypeIcon))
else (PLUS NC.LinkIconBorderWidth
NC.LinkIconBorderWidth))))
YSIZE ← YSize
YDESC ←(COND
(RightMargin (* This is in a TEdittextstream)
(PLUS (FONTDESCENT FONT)
TotalEdgeSpaceY))
(T 0))
XKERN ← 0))))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA NCP.LinkType NCP.LinkDisplayMode NCP.CardSubstance)
)
(PUTPROPS RHTPATCH094 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (983 16275 (NCP.MakeDocument 993 . 2387) (NCP.CardSubstance 2389 . 3557) (NCP.CardRegion
3559 . 4240) (NCP.CardAddText 4242 . 5336) (NCP.LocalGlobalLink 5338 . 9062) (NCP.LinkDisplayMode
9064 . 10617) (NCP.LinkType 10619 . 12570) (NCP.CardDates 12572 . 13438) (NCP.LinkAnchorDesc 13440 .
14659) (NCP.CardTypeVar 14661 . 15470) (NCP.CardTypeFn 15472 . 16273)) (16307 26988 (
NC.LinkIconDisplayFn 16317 . 22534) (NC.LinkIconImageBoxFn 22536 . 26986)))))
STOP