(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED "30-Sep-88 16:40:50" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH113.;3 38283
changes to%: (VARS PMIPATCH113COMS)
(FNS NCP.MakeTypeIconBitMapSet NC.FetchLinkIconAttachedBitMap
NC.DrawLinkOrPointerIcon NC.ComputeLinkOrPointerImageBox)
previous date%: "28-Sep-88 17:46:49" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH113.;1)
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT PMIPATCH113COMS)
(RPAQQ PMIPATCH113COMS
(
(* ;;; "New file")
(DECLARE%: DONTCOPY (PROPS (PMIPATCH113 MAKEFILE-ENVIRONMENT)
(PMIPATCH113 FILETYPE)))
(* ;; "pmi 9/28/88: This patch file provides a card type hook so that a user can put an AttachedBitMapFn fn on a card type. When calculating the bitmap for a link icon, this fn (if it exists) is applied first to a card to get the bitmap or a list of heights and bitmaps. Also provides new fn NCP.MakeTypeIconBitMapSet, which is just programmer's interface version of NC.MakeTypeIconBitMapSet, so that the user can compute the list of heights and bitmaps in his/her AttachedBitMapFn.")
(* ;; "Changed in NCCARDS")
(FNS NC.FetchLinkIconAttachedBitMap)
(* ;; "Changed in NCLINKS")
(FNS NC.DrawLinkOrPointerIcon NC.ComputeLinkOrPointerImageBox)
(* ;; "New for NCPROGINT")
(FNS NCP.MakeTypeIconBitMapSet)
(* ;; "Remove NC.FetchCrossFileLinkIconAttachedBitMap from NCCROSSFILELINKS (now obsolete).")
(* ;; " In a related change, the following stuff should be removed from NCCROSSFILELINKS (it is now available as a separate library package, NCShadedCrossFileLinks, which is where I should have put it to begin with!):")
(* ;;
"(GLOBALVARS NC.AttachedBitMapsHashArray NC.NoteFileAttachedBitMap NC.NoteFileAttachedBitMapMask)")
(* ;; "(INITVARS (NC.AttachedBitMapsHashArray))")
(* ;; "(BITMAPS NC.NoteFileAttachedBitMap NC.NoteFileAttachedBitMapMask)")
(* ;; "(FNS NC.CrossFileLinkAttachedBitMapFn NC.FetchNoteFileAttachedBitmap)")
))
(* ;;; "New file")
(DECLARE%: DONTCOPY
(PUTPROPS PMIPATCH113 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS PMIPATCH113 FILETYPE :BCOMPL)
)
(* ;;
"pmi 9/28/88: This patch file provides a card type hook so that a user can put an AttachedBitMapFn fn on a card type. When calculating the bitmap for a link icon, this fn (if it exists) is applied first to a card to get the bitmap or a list of heights and bitmaps. Also provides new fn NCP.MakeTypeIconBitMapSet, which is just programmer's interface version of NC.MakeTypeIconBitMapSet, so that the user can compute the list of heights and bitmaps in his/her AttachedBitMapFn."
)
(* ;; "Changed in NCCARDS")
(DEFINEQ
(NC.FetchLinkIconAttachedBitMap
[LAMBDA (Card ScaledHeightToMatch Scale) (* ; "Edited 28-Sep-88 17:45 by pmi")
(* ;; "Return the default link icon attached bit map corresponding to Card")
(* ;; "fgh 2/5/86 First created.")
(* ;; "rht 5/10/86: Now takes special action if BitMapVal is a list. In that case, it should be an ordered prop list of heights and bitmaps. We take the one closest in height to HeightToMatch.")
(* ;; "rht 8/7/86: Now converts single bitmap to list of bitmaps of different heights if necessary. Also now takes Scale argument.")
(* ;; "pmi 11/3/87: Now uses a default bitmap (?) if Card is NIL or its card type is undefined.")
(* ;; "pmi 2/9/88: Somehow lost the check for defined card type mentioned in previous comment. It's there now.")
(* ;; "pmi 9/28/88: Now checks for an AttachedBitMapFn on the card type, and applies it to the card to get the bitmap or list of heights and bitmaps.")
(DECLARE (GLOBALVARS NC.DefaultLinkIconAttachedBitMapHeights NC.UnknownLinkIconAttachedBitMaps))
(LET (BitMapVal AttachedBitMapFn (CardType (NCP.CardType Card)))
(if (AND Card (NCP.ValidCardType CardType))
then (if (SETQ AttachedBitMapFn (GETPROP CardType 'AttachedBitMapFn))
then (SETQ BitMapVal (APPLY* AttachedBitMapFn Card ScaledHeightToMatch Scale))
else (SETQ BitMapVal (fetch (Card LinkIconAttachedBitMap) of Card)))
[if (BITMAPP BitMapVal)
then (replace (NoteCardType LinkIconAttachedBitMap) of (NC.CardTypeRecord
CardType)
with (SETQ BitMapVal (NC.MakeTypeIconBitMapSet BitMapVal
NC.DefaultLinkIconAttachedBitMapHeights]
elseif (BITMAPP NC.UnknownLinkIconAttachedBitMaps)
then (SETQ NC.UnknownLinkIconAttachedBitMaps (SETQ BitMapVal (NC.MakeTypeIconBitMapSet
NC.UnknownLinkIconAttachedBitMaps
NC.DefaultLinkIconAttachedBitMapHeights
)))
else (SETQ BitMapVal NC.UnknownLinkIconAttachedBitMaps))
(if (LISTP BitMapVal)
then (OR ScaledHeightToMatch (SETQ ScaledHeightToMatch 0))
(OR Scale (SETQ Scale 1))
(LET (BitMap)
[for X on BitMapVal by (CDDR X)
do (LET [(ScaledHeight (TIMES Scale (CAR X]
(if (OR (NULL BitMap)
(LEQ ScaledHeight ScaledHeightToMatch))
then (SETQ BitMap (CADR X))
elseif (GREATERP ScaledHeight ScaledHeightToMatch)
then (RETURN]
BitMap])
)
(* ;; "Changed in NCLINKS")
(DEFINEQ
(NC.DrawLinkOrPointerIcon
[LAMBDA (ImageStream ImageBox LinkIconString AttachBitmapFlg Card PointerStyleFlg
BorderWidthIncrement) (* ; "Edited 28-Sep-88 17:30 by pmi")
(* ;; "Draw the icon representing either a link or a pointer object.")
(* ;; "pmi 11/3/87: Added ability to print new cross-file link icon, with bitmap attached to right side of link icon.")
(* ;; " rht 1/21/88: Now takes extra BorderWidthIncrement argument which gets added in to calc of ScaledBorderWidth.")
(* ;; "pmi 2/3/88: Did minor tweak to part that notices that the icon(s) won't fit in the width defined by NC.LinkIconMaxWidth. Added MultiLineIconFlg, which is set when we have boundary condition of title fitting on one line ONLY if we use the multi-line attached bitmap.")
(* ;; "pmi 9/28/88: NC.FetchCrossFileLinkIconAttachedBitMap has become obsolete, so now calls NC.FetchLinkIconAttachedBitMap instead.")
(DECLARE (GLOBALVARS NC.LinkIconMultiLineMode NC.LinkIconMaxWidth NC.LinkIconSpaceInnerX
NC.LinkIconSpaceOuterX NC.LinkIconSpaceInnerY NC.LinkIconSpaceOuterY
NC.LinkIconSpaceInterLine NC.LinkIconBorderWidth NC.PointerIconDashingStyle))
(PROG ((Scale (DSPSCALE NIL ImageStream))
(Font (DSPFONT NIL ImageStream))
Dashing FontDescent FontAscent FontHeight Left Bottom Top CrossFileLinkFlg ActualCard Icon
SavedIcon CrossFileLinkIcon LinkIconStrings ApproxBoxWidth ApproxBoxHeight
MultiLineIconFlg BoxWidth BoxHeight ScaledIconHeight ScaledIconWidth XPosition
ScaledLinkIconMaxWidth ScaledBorderWidth ScaledSpaceInnerX ScaledSpaceOuterX
ScaledSpaceInnerY ScaledSpaceOuterY ScaledSpaceInterLine HalfScaledSpaceInterLine
BottomOfLine)
(* ;; "Make temporaries of scaled variables")
(SETQ ScaledLinkIconMaxWidth (TIMES Scale NC.LinkIconMaxWidth))
(SETQ ScaledBorderWidth (TIMES Scale (PLUS (OR (NUMBERP BorderWidthIncrement)
0)
NC.LinkIconBorderWidth)))
(SETQ ScaledSpaceInnerX (TIMES Scale NC.LinkIconSpaceInnerX))
(SETQ ScaledSpaceOuterX (TIMES Scale NC.LinkIconSpaceOuterX))
(SETQ ScaledSpaceInnerY (TIMES Scale NC.LinkIconSpaceInnerY))
(SETQ ScaledSpaceOuterY (TIMES Scale NC.LinkIconSpaceOuterY))
(SETQ ScaledSpaceInterLine (TIMES Scale NC.LinkIconSpaceInterLine))
(SETQ HalfScaledSpaceInterLine (IQUOTIENT ScaledSpaceInterLine 2))
(SETQ FontDescent (FONTDESCENT Font))
(SETQ FontAscent (FONTASCENT Font))
(* ;; "FONTHEIGHT doesn't give us the maximum possilbe height of a font, so use (PLUS FontDescent FontAscent) instead.")
(SETQ FontHeight (PLUS FontDescent FontAscent))
(* ;; "Indicate Pointer vs Link using dashing style.")
(if PointerStyleFlg
then (SETQ Dashing NC.PointerIconDashingStyle))
(* ;; "Set up the icon, if displayed")
(if AttachBitmapFlg
then
(* ;; "Attached icon")
(* ;; "Check to see if this link points to a card in another notefile.")
(if (EQ (NCP.CardType Card)
'CrossFileLink)
then (SETQ CrossFileLinkFlg T)
(SETQ ActualCard (NCP.GetCrossFileLinkDestCard Card NIL T))
else (SETQ CrossFileLinkFlg NIL)
(SETQ ActualCard Card))
(* ;;
"Use an estimate of the width and height to tell if the box contains more than one line of text")
[if NC.LinkIconMultiLineMode
then
(* ;; "Multi-line link icons are enabled")
(SETQ ApproxBoxWidth (PLUS ScaledSpaceOuterX ScaledBorderWidth
ScaledSpaceInnerX (STRINGWIDTH LinkIconString
Font)
ScaledSpaceInnerX ScaledBorderWidth
ScaledSpaceOuterX))
(SETQ ApproxBoxHeight (PLUS ScaledSpaceOuterY ScaledBorderWidth
ScaledSpaceInnerY FontHeight
ScaledSpaceInnerY ScaledBorderWidth
ScaledSpaceOuterY))
(* ;;
"Use the box height to determine if Multi-line or Single line. Calculate the correct bitmap.")
(SETQ BoxHeight (fetch (IMAGEBOX YSIZE) of ImageBox))
(if (GREATERP BoxHeight ApproxBoxHeight)
then
(* ;; "Calculate height for Multi-line icon ")
(SETQ MultiLineIconFlg T)
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth ScaledSpaceInnerY
FontHeight HalfScaledSpaceInterLine
))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard
ScaledIconHeight Scale))
(SETQ SavedIcon (NC.FetchLinkIconAttachedBitMap ActualCard
(PLUS ScaledBorderWidth ScaledSpaceInnerY
FontHeight ScaledSpaceInnerY
ScaledBorderWidth)
Scale))
else
(* ;; "Calculate height for Single line icon")
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth ScaledSpaceInnerY
FontHeight ScaledSpaceInnerY
ScaledBorderWidth))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard
ScaledIconHeight Scale))
(SETQ SavedIcon Icon))
(SETQ ScaledIconHeight (TIMES Scale (BITMAPHEIGHT Icon)))
(SETQ ScaledIconWidth (TIMES Scale (BITMAPWIDTH Icon)))
else
(* ;; "Multi-line link icons are disabled")
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth ScaledSpaceInnerY FontHeight
ScaledSpaceInnerY ScaledBorderWidth))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard ScaledIconHeight
Scale))
(SETQ SavedIcon Icon)
(SETQ ScaledIconHeight (TIMES Scale (BITMAPHEIGHT Icon)))
(SETQ ScaledIconWidth (TIMES Scale (BITMAPWIDTH Icon]
(SETQ CrossFileLinkIcon (if CrossFileLinkFlg
then (NC.FetchLinkIconAttachedBitMap Card
ScaledIconHeight Scale)
else NIL))
else
(* ;; "No attached icon")
(SETQ Icon NIL)
(SETQ SavedIcon Icon)
(SETQ CrossFileLinkIcon NIL)
(SETQ ScaledIconHeight 0)
(SETQ ScaledIconWidth 0))
(* ;; "Now determine the text to be printed")
(if (AND Icon (GREATERP (PLUS ScaledSpaceInnerX ScaledSpaceInnerX ScaledIconWidth
(if CrossFileLinkIcon
then ScaledIconWidth
else ScaledBorderWidth))
ScaledLinkIconMaxWidth))
then
(* ;; "If the width of the icon(s)/borders plus the inner x's is greater than the ScaledLinkIconMaxWidth set by the user, set the icons and text to NIL")
(SETQ Icon NIL)
(SETQ SavedIcon Icon)
(SETQ CrossFileLinkIcon NIL)
(SETQ ScaledIconHeight 0)
(SETQ ScaledIconWidth 0)
(SETQ LinkIconStrings (LIST ""))
elseif (STREQUAL LinkIconString "")
then
(* ;; "There is no text to print, so set it to the null string")
(SETQ LinkIconStrings (LIST ""))
else
(* ;; "Have the text parsed into separate lines")
(SETQ LinkIconStrings (NC.CreateLinkIconStrings LinkIconString Icon
CrossFileLinkIcon ImageStream)))
(* ;; "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)))
(SETQ Top (PLUS Bottom BoxHeight))
(SETQ Left (PLUS (DSPXPOSITION NIL ImageStream)
ScaledSpaceOuterX))
(SETQ BoxWidth (DIFFERENCE (fetch (IMAGEBOX XSIZE) of ImageBox)
(PLUS ScaledSpaceOuterX ScaledSpaceOuterX)))
(* ;; "Display the icon, if possible")
(if (AND Icon (LEQ (PLUS (if CrossFileLinkIcon
then ScaledIconWidth
else ScaledBorderWidth)
ScaledIconWidth ScaledSpaceInnerX ScaledSpaceInnerX)
ScaledLinkIconMaxWidth))
then
(* ;; "Put out the icon bitmap, but only if the width of the icon(s)/borders plus the inner x's does not exceed the LinkIconMaxWidth set by the user.")
(BITBLT Icon 0 0 ImageStream Left (DIFFERENCE Top ScaledIconHeight))
(* ;; "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 (ZEROP (NCHARS LinkIconString))
then
(* ;; "Display the cross-file link icon, if necessary")
(if CrossFileLinkIcon
then (BITBLT CrossFileLinkIcon 0 0 ImageStream
(DIFFERENCE (PLUS Left BoxWidth)
ScaledIconWidth)
(DIFFERENCE Top ScaledIconHeight)))
(* ;; "Quit because just a typeicon")
(RETURN))
else
(* ;; "There isn't enough space for the icon, so set it to NIL")
(SETQ Icon NIL)
(SETQ ScaledIconWidth 0))
(* ;; "Enter the appropriate text.")
(SETQ XPosition (PLUS Left (if Icon
then ScaledIconWidth
else ScaledBorderWidth)
ScaledSpaceInnerX))
(DSPXPOSITION XPosition ImageStream)
(if LinkIconStrings
then (if (OR (GREATERP (LENGTH LinkIconStrings)
1)
MultiLineIconFlg)
then (SETQ BottomOfLine (DIFFERENCE Top (PLUS ScaledBorderWidth
ScaledSpaceInnerY FontAscent)))
(SETQ XPosition (PLUS Left ScaledSpaceInnerX ScaledBorderWidth))
(for String in LinkIconStrings
do (DSPYPOSITION BottomOfLine ImageStream)
(PRIN1 String ImageStream)
(SETQ BottomOfLine (DIFFERENCE BottomOfLine (PLUS FontDescent
ScaledSpaceInterLine
FontAscent)))
(DSPXPOSITION XPosition ImageStream))
(* ;; "Draw the box for multiple lines of text.")
(NC.DrawInnerBox Left Bottom BoxWidth BoxHeight ScaledBorderWidth NIL
ImageStream Dashing Icon CrossFileLinkIcon ScaledIconWidth
ScaledIconHeight)
else (DSPYPOSITION (PLUS Bottom ScaledBorderWidth ScaledSpaceInnerY FontDescent)
ImageStream)
(PRIN1 (CAR LinkIconStrings)
ImageStream)
(* ;; "Draw the box for a single line of text.")
(NC.DrawInnerBox (PLUS Left ScaledIconWidth)
Bottom
(DIFFERENCE BoxWidth (if CrossFileLinkIcon
then (PLUS ScaledIconWidth ScaledIconWidth)
else ScaledIconWidth))
BoxHeight ScaledBorderWidth NIL ImageStream Dashing Icon
CrossFileLinkIcon)))
(* ;; "Display the cross-file link icon, if necessary")
(if CrossFileLinkIcon
then (BITBLT CrossFileLinkIcon 0 0 ImageStream (DIFFERENCE (PLUS Left BoxWidth)
ScaledIconWidth)
(DIFFERENCE Top ScaledIconHeight])
(NC.ComputeLinkOrPointerImageBox
[LAMBDA (ImageStream LinkIconString AttachBitmapFlg Card RightMargin BorderWidthIncrement)
(* ; "Edited 28-Sep-88 17:30 by pmi")
(* ;; "Compute the size of the image box needed to print a link or pointer icon.")
(* ;; "pmi 11/3/87: Added ability to print new cross-file link icon, with bitmap attached to right side of link icon.")
(* ;; " rht 1/21/88: Now takes extra BorderWidthIncrement argument which gets added in to calc of ScaledBorderWidth.")
(* ;; "pmi 2/3/88: Did minor tweak to various things. Added MultiLineIconFlg, which is set when we have boundary condition of title fitting on one line ONLY if we use the multi-line attached bitmap.")
(* ;; "pmi 9/28/88: NC.FetchCrossFileLinkIconAttachedBitMap has become obsolete, so now calls NC.FetchLinkIconAttachedBitMap instead.")
(DECLARE (GLOBALVARS NC.LinkIconMultiLineMode NC.LinkIconMaxWidth NC.LinkIconBorderWidth
NC.LinkIconSpaceInnerX NC.LinkIconSpaceOuterX NC.LinkIconSpaceInnerY
NC.LinkIconSpaceOuterY NC.LinkIconSpaceInterLine))
(LET ((Scale (DSPSCALE NIL ImageStream))
(BoxWidth 0)
(Font (DSPFONT NIL ImageStream))
CrossFileLinkFlg ActualCard Icon SavedIcon CrossFileLinkIcon FontHeight ApproxBoxWidth
MultiLineIconFlg LinkIconStrings ScaledIconHeight ScaledIconWidth NumberOfLines XSize YSize
ScaledLinkIconMaxWidth ScaledBorderWidth ScaledSpaceInnerX ScaledSpaceOuterX
ScaledSpaceInnerY ScaledSpaceOuterY ScaledSpaceInterLine HalfScaledSpaceInterLine
TotalEdgeSpaceY)
(* ;; "FONTHEIGHT doesn't give us the maximum possilbe height of a font, so use (PLUS FontDescent FontAscent) instead.")
(SETQ FontHeight (PLUS (FONTDESCENT Font)
(FONTASCENT Font)))
(* ;; "Make temporaries of scaled vars.")
(SETQ ScaledLinkIconMaxWidth (TIMES Scale NC.LinkIconMaxWidth))
(SETQ ScaledBorderWidth (TIMES Scale (PLUS (OR (NUMBERP BorderWidthIncrement)
0)
NC.LinkIconBorderWidth)))
(SETQ ScaledSpaceInnerX (TIMES Scale NC.LinkIconSpaceInnerX))
(SETQ ScaledSpaceOuterX (TIMES Scale NC.LinkIconSpaceOuterX))
(SETQ ScaledSpaceInnerY (TIMES Scale NC.LinkIconSpaceInnerY))
(SETQ ScaledSpaceOuterY (TIMES Scale NC.LinkIconSpaceOuterY))
(SETQ ScaledSpaceInterLine (TIMES Scale NC.LinkIconSpaceInterLine))
(SETQ HalfScaledSpaceInterLine (IQUOTIENT ScaledSpaceInterLine 2))
(* *)
(SETQ TotalEdgeSpaceY (PLUS ScaledBorderWidth ScaledSpaceOuterY ScaledSpaceInnerY))
(SETQ YSize (PLUS TotalEdgeSpaceY TotalEdgeSpaceY FontHeight))
(* ;; "Set up the icon, if displayed")
(if AttachBitmapFlg
then
(* ;; "Attached icon")
(* ;; "Check to see if this link points to a card in another notefile.")
(if (EQ (NCP.CardType Card)
'CrossFileLink)
then (SETQ CrossFileLinkFlg T)
(SETQ ActualCard (NCP.GetCrossFileLinkDestCard Card NIL T))
else (SETQ CrossFileLinkFlg NIL)
(SETQ ActualCard Card))
(* ;;
"Use an estimate of the width to tell if the box contains more than one line of text")
[if NC.LinkIconMultiLineMode
then
(* ;; "Multi-line link icons are enabled")
(SETQ ApproxBoxWidth (PLUS ScaledSpaceInnerX (STRINGWIDTH LinkIconString
Font)
ScaledSpaceInnerX))
(* ;; "The image box must be calculated")
[if (GREATERP ApproxBoxWidth ScaledLinkIconMaxWidth)
then (* ; "Calculate Multi-line icon")
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth ScaledSpaceInnerY
FontHeight HalfScaledSpaceInterLine)
)
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard
ScaledIconHeight Scale))
(SETQ SavedIcon Icon)
(SETQ ScaledIconHeight (TIMES Scale (BITMAPHEIGHT Icon)))
(SETQ ScaledIconWidth (TIMES Scale (BITMAPWIDTH Icon)))
else
(* ;; "Calculate Single line icon")
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth ScaledSpaceInnerY
FontHeight ScaledSpaceInnerY
ScaledBorderWidth))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard
ScaledIconHeight Scale))
(SETQ SavedIcon Icon)
(SETQ ScaledIconHeight (TIMES Scale (BITMAPHEIGHT Icon)))
(SETQ ScaledIconWidth (TIMES Scale (BITMAPWIDTH Icon)))
(* ;;
"Now see if total width, including the icon, will still fit if this is a Single line")
(if (AND (NOT (STREQUAL LinkIconString ""))
(GREATERP (PLUS ApproxBoxWidth ScaledIconWidth
(if CrossFileLinkFlg
then ScaledIconWidth
else ScaledBorderWidth))
ScaledLinkIconMaxWidth))
then
(* ;; "Now it doesn't fit. Calculate Multi-line icon ")
(SETQ MultiLineIconFlg T)
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth
ScaledSpaceInnerY FontHeight
HalfScaledSpaceInterLine))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard
ScaledIconHeight Scale))
(SETQ SavedIcon (NC.FetchLinkIconAttachedBitMap
ActualCard
(PLUS ScaledBorderWidth ScaledSpaceInnerY
FontHeight ScaledSpaceInnerY
ScaledBorderWidth)
Scale))
(SETQ ScaledIconHeight (TIMES Scale (BITMAPHEIGHT Icon)))
(SETQ ScaledIconWidth (TIMES Scale (BITMAPWIDTH Icon]
else
(* ;; "Multi-line link icons are disabled")
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth ScaledSpaceInnerY FontHeight
ScaledSpaceInnerY ScaledBorderWidth))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard ScaledIconHeight Scale
))
(SETQ SavedIcon Icon)
(SETQ ScaledIconHeight (TIMES Scale (BITMAPHEIGHT Icon)))
(SETQ ScaledIconWidth (TIMES Scale (BITMAPWIDTH Icon]
(SETQ CrossFileLinkIcon (if CrossFileLinkFlg
then (NC.FetchLinkIconAttachedBitMap Card
ScaledIconHeight Scale)
else NIL))
else
(* ;; "No attached icon")
(SETQ Icon NIL)
(SETQ SavedIcon Icon)
(SETQ CrossFileLinkIcon NIL)
(SETQ ScaledIconHeight 0)
(SETQ ScaledIconWidth 0))
(* ;; "Now determine the actual size of the image box")
[if (AND Icon (GREATERP (PLUS ScaledSpaceInnerX ScaledSpaceInnerX ScaledIconWidth
(if CrossFileLinkIcon
then ScaledIconWidth
else ScaledBorderWidth))
ScaledLinkIconMaxWidth))
then
(* ;; "If the width of the icon plus the width of the cross-file link icon (if any) plus the inner x's is greater than the ScaledLinkIconMaxWidth set by the user, set the box width to ScaledLinkIconMaxWidth plus the width of the outer x's.")
(SETQ XSize (PLUS ScaledSpaceOuterX ScaledSpaceOuterX ScaledLinkIconMaxWidth))
elseif (ZEROP (NCHARS LinkIconString))
then (if Icon
then
(* ;; "There is no text to print, so the box width is just the icon width plus the width of the cross-file link icon (if any) plus the outer x on each side")
(SETQ XSize (PLUS ScaledSpaceOuterX ScaledSpaceOuterX ScaledIconWidth
(if CrossFileLinkIcon
then ScaledIconWidth
else ScaledBorderWidth)))
else
(* ;; "There is no text or Icon to print, so the box width is just the inner x, border width, and outer x on each side")
(SETQ XSize (PLUS ScaledSpaceInnerX ScaledSpaceInnerX ScaledBorderWidth
ScaledBorderWidth ScaledSpaceOuterX ScaledSpaceOuterX)))
else
(* ;; "Have the text parsed into separate lines")
(SETQ LinkIconStrings (NC.CreateLinkIconStrings LinkIconString Icon CrossFileLinkIcon
ImageStream))
(if LinkIconStrings
then (SETQ NumberOfLines (LENGTH LinkIconStrings))
[if (GREATERP NumberOfLines 1)
then (SETQ BoxWidth (PLUS (STRINGWIDTH (CAR LinkIconStrings)
Font)
(if Icon
then ScaledIconWidth
else ScaledBorderWidth)
(if CrossFileLinkIcon
then ScaledIconWidth
else ScaledBorderWidth)))
(* ;; "Find the longest string for the width of the box")
(for String in (CDR LinkIconStrings) bind PartStringWidth
when (GREATERP (SETQ PartStringWidth (PLUS (STRINGWIDTH String
Font)
ScaledBorderWidth
ScaledBorderWidth))
BoxWidth) do (SETQ BoxWidth PartStringWidth))
(SETQ YSize (PLUS TotalEdgeSpaceY TotalEdgeSpaceY (TIMES
NumberOfLines
FontHeight
)
(TIMES (SUB1 NumberOfLines)
ScaledSpaceInterLine)))
else
(* ;; "It's possible to have a string that won't fit on one line with a single line icon, but will fit if we use the multi-line icon. In this case, we have to fool it into thinking it has another line.")
[if (AND MultiLineIconFlg (EQ NumberOfLines 1))
then (SETQ NumberOfLines (ADD1 NumberOfLines))
(SETQ YSize (PLUS TotalEdgeSpaceY TotalEdgeSpaceY
(TIMES NumberOfLines FontHeight)
(TIMES (SUB1 NumberOfLines)
ScaledSpaceInterLine]
(SETQ BoxWidth (PLUS (STRINGWIDTH (CAR LinkIconStrings)
Font)
(if Icon
then ScaledIconWidth
else ScaledBorderWidth)
(if CrossFileLinkIcon
then ScaledIconWidth
else ScaledBorderWidth]
(SETQ XSize (MIN (PLUS BoxWidth ScaledSpaceOuterX ScaledSpaceOuterX
ScaledSpaceInnerX ScaledSpaceInnerX)
(PLUS ScaledLinkIconMaxWidth ScaledSpaceOuterX
ScaledSpaceOuterX]
(create IMAGEBOX
XSIZE ← XSize
YSIZE ← YSize
YDESC ← (COND
(RightMargin
(* ;; "This is in a TEdittextstream")
(PLUS (FONTDESCENT Font)
TotalEdgeSpaceY))
(T 0))
XKERN ← 0])
)
(* ;; "New for NCPROGINT")
(DEFINEQ
(NCP.MakeTypeIconBitMapSet
[LAMBDA (Bitmap Heights) (* ; "Edited 27-Sep-88 11:53 by pmi")
(* ;; "Programmer's interface function for NC.MakeTypeIconBitMapSet.")
(* ;; "Create a prop list of pairs of Height and scaled copies of Bitmap having that height. If Heights is NIL, NC.DefaultLinkIconAttachedBitMapHeights is used.")
(DECLARE (GLOBALVARS NC.DefaultLinkIconAttachedBitMapHeights))
(NC.MakeTypeIconBitMapSet Bitmap (OR Heights NC.DefaultLinkIconAttachedBitMapHeights])
)
(* ;; "Remove NC.FetchCrossFileLinkIconAttachedBitMap from NCCROSSFILELINKS (now obsolete).")
(* ;;
" In a related change, the following stuff should be removed from NCCROSSFILELINKS (it is now available as a separate library package, NCShadedCrossFileLinks, which is where I should have put it to begin with!):"
)
(* ;;
"(GLOBALVARS NC.AttachedBitMapsHashArray NC.NoteFileAttachedBitMap NC.NoteFileAttachedBitMapMask)")
(* ;; "(INITVARS (NC.AttachedBitMapsHashArray))")
(* ;; "(BITMAPS NC.NoteFileAttachedBitMap NC.NoteFileAttachedBitMapMask)")
(* ;; "(FNS NC.CrossFileLinkAttachedBitMapFn NC.FetchNoteFileAttachedBitmap)")
(PUTPROPS PMIPATCH113 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3056 6438 (NC.FetchLinkIconAttachedBitMap 3066 . 6436)) (6475 36924 (
NC.DrawLinkOrPointerIcon 6485 . 21463) (NC.ComputeLinkOrPointerImageBox 21465 . 36922)) (36960 37525 (
NCP.MakeTypeIconBitMapSet 36970 . 37523)))))
STOP