(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED "23-Jan-88 20:53:44" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH304.;11 92598
changes to%: (FNS NC.LinkIconMiddleButtonFn NC.BrowserCreateLink NC.MakeLinksLegendMenu
NC.BrowserRemoveNode NC.SelectGraphNode)
(VARS RHTPATCH304COMS)
previous date%: "22-Jan-88 01:50:47" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH304.;8)
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT RHTPATCH304COMS)
(RPAQQ RHTPATCH304COMS ((DECLARE%: DONTCOPY (PROPS (RHTPATCH304 MAKEFILE-ENVIRONMENT)
(RHTPATCH304 FILETYPE)))
[DECLARE%: COPY FIRST (P (NC.LoadFileFromDirectories 'NCBROWSERCARD]
(* ;;; "Miscellaneous fixes - mostly uncovered by hacking on the guided tour library package.")
(* ;; "New functions for NCBROWSERCARD")
(FNS NC.CursorInsideGraphNodeP NC.CardFromBrowserNode)
(* ;; "Changes to NCBROWSERCARD")
(FNS NC.BrowserFixGraphEditMenuFn NC.GetGraphEditMenu NC.BrowserAddLink
NC.BrowserCreateLink NC.BrowserCardQuitFn NC.BringUpBrowserCard
NC.MakeLinksLegendMenu NC.BrowserRemoveNode NC.SelectGraphNode)
(* ;; "Changes to NCGRAPHCARD")
(FNS NC.GraphCardShrinkFn)
(* ;; "Changes to NCLINKS")
(FNS NC.LinkIconMiddleButtonFn NC.DrawLinkOrPointerIcon
NC.ComputeLinkOrPointerImageBox NC.LinkIconDisplayFn
NC.LinkIconImageBoxFn NC.PointerIconDisplayFn NC.PointerIconImageBoxFn)
(* ;; "Change to NCPROGINT")
(FNS NCP.SelectCards)))
(DECLARE%: DONTCOPY
(PUTPROPS RHTPATCH304 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS RHTPATCH304 FILETYPE :TCOMPL)
)
(DECLARE%: COPY FIRST
(NC.LoadFileFromDirectories 'NCBROWSERCARD)
)
(* ;;; "Miscellaneous fixes - mostly uncovered by hacking on the guided tour library package.")
(* ;; "New functions for NCBROWSERCARD")
(DEFINEQ
(NC.CursorInsideGraphNodeP
[LAMBDA (GraphNode Window) (* ; "Edited 19-Jan-88 18:58 by Trigg")
(* ;; "Return non-nil if current cursor position is inside the region of GraphNode.")
(LET ((NodePosition (fetch (GRAPHNODE NODEPOSITION) of GraphNode))
(NodeHeight (fetch (GRAPHNODE NODEHEIGHT) of GraphNode))
(NodeWidth (fetch (GRAPHNODE NODEWIDTH) of GraphNode)))
(INSIDEP (CREATEREGION (DIFFERENCE (fetch (POSITION XCOORD) of NodePosition)
(LRSH NodeWidth 1))
(DIFFERENCE (fetch (POSITION YCOORD) of NodePosition)
(LRSH NodeHeight 1))
NodeWidth NodeHeight)
(CURSORPOSITION NIL Window])
(NC.CardFromBrowserNode
[LAMBDA (GraphNode) (* ; "Edited 21-Jan-88 22:37 by Trigg")
(* ;; "If this is a graph node that corresponds to a valid notecard, then return the card.")
(LET [(Card (NC.CardFromBrowserNodeID (NC.CoerceToGraphNodeID GraphNode]
(if (NCP.ValidCardP Card)
then Card])
)
(* ;; "Changes to NCBROWSERCARD")
(DEFINEQ
(NC.BrowserFixGraphEditMenuFn
[LAMBDA (Window) (* ; "Edited 14-Jan-88 20:50 by Trigg")
(* ;;
"Attach the Graph edit menu to the side of the browser window. Put it below the links legend.")
(* ;;
"rht 9/20/85: Now uses ADDMENU offscreen so it doesn't flash in lower left corner before coming up.")
(* ;; "rht 3/3/86: Now does some 'random' WINDOWPROPS to make reshaping browser not screw up the attached menu.")
(* ;; "rht 3/7/86: Uses ATTACHMENU to attach the menu.")
(* ;; "pmi 3/25/87: Added NC.MenuFont to all menus")
(* ;;
"rht 1/14/88: Now copies existing menu hung off window rather than building new one from scratch.")
(DECLARE (GLOBALVARS NC.MenuFont))
(LET (GraphEditMenu GraphEditMenuWin)
[SETQ GraphEditMenu (create MENU using (WINDOWPROP Window 'GRAPHEDITUNFIXABLEMENU]
(PUTMENUPROP GraphEditMenu 'MAINWINDOW Window)
(SETQ GraphEditMenuWin (ATTACHMENU GraphEditMenu Window 'RIGHT 'BOTTOM))
(* ;
"Rig so that close of menu won't close browser.")
(WINDOWDELPROP GraphEditMenuWin 'PASSTOMAINCOMS 'CLOSEW)
(WINDOWPROP GraphEditMenuWin 'GRAPHEDITMENUFLG T)
(WINDOWADDPROP GraphEditMenuWin 'CLOSEFN [FUNCTION (LAMBDA (W)
(DETACHWINDOW W]
T])
(NC.GetGraphEditMenu
[LAMBDA (Window) (* ; "Edited 14-Jan-88 21:07 by Trigg")
(* ;; "Create, if necessary, and bring up the graph editor menu.")
(* ;; "pmi 3/25/87: Added NC.MenuFont to all menus")
(* ;;
"rht 1/14/88: Now ensures that both menus are computed rather than just the one needed.")
(DECLARE (GLOBALVARS NC.MenuFont NC.GraphEditMenuItems NC.GraphEditUnfixedMenuItems))
(LET [(GraphEditUnfixableMenu (WINDOWPROP Window 'GRAPHEDITUNFIXABLEMENU))
(GraphEditFixableMenu (WINDOWPROP Window 'GRAPHEDITFIXABLEMENU]
[OR GraphEditUnfixableMenu (WINDOWPROP Window 'GRAPHEDITUNFIXABLEMENU
(SETQ GraphEditUnfixableMenu
(create MENU
ITEMS ← NC.GraphEditMenuItems
TITLE ← "Editor Menu"
WHENSELECTEDFN ← (FUNCTION
NC.GraphEditMenuWhenSelectedFn)
CHANGEOFFSETFLG ← T
CENTERFLG ← T
MENUOFFSET ← (CONS -1 0)
MENUFONT ← NC.MenuFont
ITEMHEIGHT ← (IPLUS (FONTPROP NC.MenuFont
'HEIGHT)
1]
[OR GraphEditFixableMenu (WINDOWPROP Window 'GRAPHEDITFIXABLEMENU
(SETQ GraphEditFixableMenu
(create MENU using GraphEditUnfixableMenu ITEMS ←
NC.GraphEditUnfixedMenuItems]
(* ;; "If menu is already up, then put up a menu without the FIXMENU option, otherwise, allow user to fix menu.")
(if [for Win in (ATTACHEDWINDOWS Window) thereis (AND (OPENWP Win)
(WINDOWPROP Win 'GRAPHEDITMENUFLG]
then (PUTMENUPROP GraphEditUnfixableMenu 'MAINWINDOW Window)
(MENU GraphEditUnfixableMenu)
else (PUTMENUPROP GraphEditFixableMenu 'MAINWINDOW Window)
(MENU GraphEditFixableMenu])
(NC.BrowserAddLink
[LAMBDA (FromNode ToNode Win Graph GlobalLinkFlg LinkType) (* ; "Edited 16-Jan-88 16:09 by Trigg")
(* ;;
"Like grapher's ADD/AND/DISPLAY/LINK except has different checks and builds a real NC Link.")
(* ;; "rht 9/20/85: Added GlobalLinkFlg arg to force the link created to be global. Currently, it's global anyway if from node is a sketch card, for example.")
(* ;; "rht 11/17/85: updated for new card and notefile object format.")
(* ;; "rht 2/7/86: Now sets and gets browser link labels, etc. via fetch/set fns.")
(* ;; "rht 1/14/88: Now takes extra LinkType argument and passes to NC.BrowserCreateLink.")
(PROG ((MaxDashingStylesNum (LENGTH NC.DashingStyles))
Link Card LabelPairs LabelPair LabelNum ToNodeID FromNodeID OldDestNode LinkParams
ReverseLinkParams SavedDeleteLinkFn NumberOfLinks)
(COND
([NOT (AND (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of FromNode))
(NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of ToNode]
(NC.PrintMsg NIL T
"Can't create link from or to a label node. Try 'Add Edge' instead.")
(FLASHW PROMPTWINDOW)
(RETURN NIL))
((SETQ Link (NC.BrowserCreateLink FromNode ToNode Graph Win GlobalLinkFlg LinkType))
(* ;
"We successfully created a link. Now undraw existing link and redraw with new one added.")
(* ;
"First, check whether label for new link is already in graph.")
(SETQ Card (NC.CoerceToCard Win))
(SETQ LabelPairs (NC.FetchBrowserLinksLegend Card))
(SETQ LinkType (fetch (Link Label) of Link))
(* ;; "If link label hasn't appeared in the graph, make a new dashing number for it and update links legend.")
(if (NULL (SETQ LabelPair (FASSOC LinkType LabelPairs)))
then [SETQ LabelPairs (APPEND LabelPairs (LIST (SETQ LabelPair
(CONS LinkType
(COND
((ILESSP (SETQ LabelNum
(LENGTH
LabelPairs
))
MaxDashingStylesNum
)
(SETQ LabelNum
(ADD1 LabelNum)))
(T LabelNum]
(NC.SetBrowserLinksLegend Card LabelPairs)
(NC.MakeLinksLegendMenu Win LabelPairs))
(SETQ FromNodeID (NC.CoerceToGraphNodeID FromNode))
(SETQ ToNodeID (NC.CoerceToGraphNodeID ToNode))
[SETQ NumberOfLinks (PLUS (LENGTH (NC.GraphNodeIDGetProp FromNodeID ToNodeID))
(LENGTH (NC.GraphNodeIDGetProp ToNodeID FromNodeID]
(SETQ LinkParams (LINKPARAMETERS FromNode ToNode))
(SETQ ReverseLinkParams (LINKPARAMETERS ToNode FromNode))
[COND
[(OR (ZEROP NumberOfLinks)
(AND (NULL LinkParams)
(NULL ReverseLinkParams)))
(if (OR (FMEMB (fetch (GRAPHNODE NODEID) of FromNode)
(fetch (GRAPHNODE TONODES) of ToNode))
(FMEMB (fetch (GRAPHNODE NODEID) of ToNode)
(fetch (GRAPHNODE TONODES) of FromNode)))
then (* ;
"There are no links, but there is an edge. Delete it and redisplay.")
(SETQ SavedDeleteLinkFn (fetch (GRAPH GRAPH.DELETELINKFN) of Graph))
(replace (GRAPH GRAPH.DELETELINKFN) of Graph with NIL)
(DELETE/AND/DISPLAY/LINK FromNode ToNode Win Graph)
(NC.PrintMsg NIL T "Replacing existing edge with new link edge.")
(FLASHW PROMPTWINDOW)) (* ;
"This is first link between these two nodes so compute dashing here.")
(replace (GRAPHNODE TONODES) of FromNode
with (CONS [LIST LINKPARAMS (fetch (GRAPHNODE NODEID) of ToNode)
'DRAWLINKFN
(FUNCTION NC.BrowserDrawLinkFn)
'DASHING
(CAR (FNTH NC.DashingStyles (CDR LabelPair]
(fetch (GRAPHNODE TONODES) of FromNode)))
(replace (GRAPHNODE FROMNODES) of ToNode with (CONS (fetch (GRAPHNODE NODEID)
of FromNode)
(fetch (GRAPHNODE FROMNODES)
of ToNode]
[LinkParams (* ;
"There are multiple links. And the link params is on the FromNode.")
(DISPLAYLINK FromNode ToNode (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Win Graph 1 LinkParams) (* ;
"If there was only one link, then change so multi-link indicator.")
(if (EQP NumberOfLinks 1)
then (RPLACD (CDR LinkParams)
(LIST 'NODEID FromNodeID 'DESTNODEID ToNodeID]
(T (* ;
"There are multiple links. The Link params is on the ToNode.")
(DISPLAYLINK ToNode FromNode (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Win Graph 1 ReverseLinkParams) (* ;
"If there was only one link, then change so multi-link indicator.")
(if (EQP NumberOfLinks 1)
then (RPLACD (CDR ReverseLinkParams)
(LIST 'NODEID ToNodeID 'DESTNODEID FromNodeID]
(NC.UIDAddProp FromNodeID ToNodeID LabelPair)
[COND
(LinkParams (DISPLAYLINK FromNode ToNode
(CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Win Graph 1 LinkParams))
(ReverseLinkParams (DISPLAYLINK ToNode FromNode
(CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Win Graph 1 ReverseLinkParams))
(T (DISPLAYLINK FromNode ToNode (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Win Graph 1 (LINKPARAMETERS FromNode ToNode]
(RETURN NIL])
(NC.BrowserCreateLink
[LAMBDA (FromNode ToNode Graph Window GlobalLinkFlg LinkType)
(* ; "Edited 22-Jan-88 18:03 by Trigg")
(* ;; "Called by grapher when user creates a new link.")
(* ;; "rht 9/20/85: Added GlobalLinkFlg arg to force the link created to be global. Currently, it's global anyway if from node is a sketch card, for example.")
(* ;; "rht 11/17/85: Updated to hancdle new card and notefile formats.")
(* ;; "rht 1/14/88: Now takes extra LinkType argument.")
(DECLARE (GLOBALVARS PROMPTWINDOW NC.FiledCardLinkLabel NC.SubBoxLinkLabel))
(LET ((GraphCard (NC.CoerceToCard Window))
SourceCard DestinationCard)
(if (EQ FromNode ToNode)
then (NC.PrintMsg NIL T "Can't create a link from node to itself.")
(FLASHW PROMPTWINDOW)
NIL
else (NC.MarkCardDirty GraphCard)
(SETQ SourceCard (NC.CardFromBrowserNodeID (NC.CoerceToGraphNodeID FromNode)))
(SETQ DestinationCard (NC.CardFromBrowserNodeID (NC.CoerceToGraphNodeID ToNode)))
[OR LinkType (SETQ LinkType (COND
((AND (NOT GlobalLinkFlg)
(NC.FileBoxP SourceCard T))
(COND
((NC.FileBoxP DestinationCard T)
NC.SubBoxLinkLabel)
(T NC.FiledCardLinkLabel)))
(T (NC.AskLinkLabel Window NIL NIL T T]
(AND LinkType (COND
((AND (NOT GlobalLinkFlg)
(NC.TEditBasedP SourceCard))
(NCP.LocalGlobalLink LinkType SourceCard DestinationCard
'END))
(T (NCP.GlobalGlobalLink LinkType SourceCard DestinationCard])
(NC.BrowserCardQuitFn
[LAMBDA (Card) (* ; "Edited 15-Jan-88 20:00 by Trigg")
(* ;; "This clears all UserData fields of Graph node UIDs. I ONLY HAVE TO DO THIS BECAUSE INTERLISP WON'T GC CYCLES!")
(* ;; "rht 1/15/88: Had to replace the NCP.ApplySuperTypeFn call with grungy apply* to prevent infinite recursive calls.")
[for GraphNode in (fetch (GRAPH GRAPHNODES) of (NC.FetchSubstance Card))
do (LET ((GraphNodeID (NC.CoerceToGraphNodeIDOrLabel GraphNode)))
(AND (type? UID GraphNodeID)
(NC.UIDSetPropList GraphNodeID NIL]
(APPLY* (NCP.CardTypeFn 'Graph 'QuitFn)
Card])
(NC.BringUpBrowserCard
[LAMBDA (Card Substance Region/Position) (* ; "Edited 16-Jan-88 15:55 by Trigg")
(* ;;
"Given a browser Substance, open a browser window and set it up to be a NoteCard with ID.")
(* ;; "rht 11/17/84: Now returns window.")
(* ;; "rht 9/11/85: Now checks for changed link icon display global params.")
(* ;; "rht 11/17/85: Now handles new card and Notefile objects.")
(* ;; "rht 2/1/86: Now restores any saved UID user data info stashed on card's prop list.")
(* ;; "fgh 2/5/86 Added call to NC.ApplySupersFn")
(* ;; "rht 2/14/86: Now rebuilds browser hash array.")
(* ;; "rht 2/28/86: Added WINDOWPROP for SCROLLFN and RESHAPEFN.")
(* ;; "rht 3/2/86: Took out call to NC.FetchBrowserHashArray.")
(* ;;
"rht 4/5/86: Now only replaces graphnodes' TONODES' NODEID and DESTNODEID if they're non-nil.")
(* ;; "rht 5/5/86: Took out call to NC.SetupTitleBarMenu.")
(* ;; "rht&pmi 2/6/87: Moved call to NC.GraphLinkIconUpdateCheck in front of call to GraphCard's EditFn so as to remove 'double display' problem.")
(* ;; "rht 1/16/88: Had to replace the ApplySuperTypeFn call with grungy apply* to prevent infinite recursive calls.")
(LET ((GraphNodes (fetch (GRAPH GRAPHNODES) of Substance))
Window OldUIDToNewUIDHashArray BrowserSavedLinkingInfo)
(* ;; "Restore any saved UID user data info stashed on card UID's prop list.")
[if (SETQ BrowserSavedLinkingInfo (NC.FetchBrowserSavedLinkingInfo Card))
then (SETQ OldUIDToNewUIDHashArray (HASHARRAY 100 NIL (FUNCTION NC.MakeHashKey)
(FUNCTION NC.SameUIDP)))
(for BrowserSavedLinkingInfoForNode in BrowserSavedLinkingInfo eachtime (BLOCK)
bind SourceUID when (SETQ SourceUID (NC.NewBrowserNodeUIDFromOldUID (CAR
BrowserSavedLinkingInfoForNode
)
GraphNodes OldUIDToNewUIDHashArray))
do (for SavedLinkingInfo on (CDR BrowserSavedLinkingInfoForNode)
by (CDDR SavedLinkingInfo) eachtime (BLOCK)
do (NC.GraphNodeIDPutProp SourceUID (NC.NewBrowserNodeUIDFromOldUID
(CAR SavedLinkingInfo)
GraphNodes OldUIDToNewUIDHashArray)
(CADR SavedLinkingInfo]
(NC.SetBrowserSavedLinkingInfo Card NIL)
(* ;;
"For each graph node corresponding to a notecard, hang the card object off the node id's prop list.")
[for GraphNode in GraphNodes bind LinkIcon DestCard eachtime (BLOCK)
when (NC.LinkIconImageObjP (SETQ LinkIcon (fetch (GRAPHNODE NODELABEL) of GraphNode)))
do (NC.GraphNodeIDPutProp (NC.CoerceToGraphNodeID GraphNode)
'CardObject
(SETQ DestCard (fetch (Link DestinationCard) of (NC.FetchLinkFromLinkIcon
LinkIcon]
(* ;; "Make a new browser hash array with the new graph node UIDs.")
(NC.SetUserDataProp Card 'BrowserHashArray NIL)
(NC.GetBrowserHashArray Card Substance)
(* ;;
"For each graph node, fix the NODEID and DESTNODEID fields of each of its TONODES LinkParameters.")
[for GraphNode in GraphNodes eachtime (BLOCK)
do (for ToNode in (fetch (GRAPHNODE TONODES) of GraphNode)
bind (ThisNodeID ← (NC.CoerceToGraphNodeID GraphNode)) eachtime (BLOCK)
when (EQ (CAR ToNode)
LINKPARAMS) do (AND (LISTGET ToNode 'NODEID)
(LISTPUT ToNode 'NODEID ThisNodeID))
(AND (LISTGET ToNode 'DESTNODEID)
(LISTPUT ToNode 'DESTNODEID (NC.CoerceToGraphNodeID
(CADR ToNode]
(* ;; "Bring up card and mess with its window.")
(NC.GraphLinkIconUpdateCheck Card NIL Substance T)
(SETQ Window (APPLY* (NCP.CardTypeFn 'Graph 'EditFn)
Card Substance Region/Position))
(* ;; "I have to hang notecard's Card on window now in case REDISPLAYW runs and tries to get Card from window.")
(WINDOWPROP Window 'NoteCardObject Card)
(NC.MakeLinksLegendMenu Window (NC.FetchBrowserLinksLegend Card))
(* ;
"Disable the old-style right button grapher editor menu.")
(WINDOWPROP Window 'RIGHTBUTTONFN (FUNCTION NC.BrowserRightButtonFn))
(WINDOWADDPROP Window 'SHRINKFN (FUNCTION NC.GraphCardShrinkFn))
(WINDOWADDPROP Window 'REPAINTFN (FUNCTION NC.BrowserRepaintFn)
T)
(WINDOWPROP Window 'SCROLLFN (FUNCTION NC.BrowserScrollFn))
(WINDOWPROP Window 'RESHAPEFN (FUNCTION NC.BrowserReshapeFn))
(* ;; "Check if link icon display global params have changed since last time card was up. If so, fix graph nodes and redisplay.")
(* ;
"if (NC.GraphLinkIconUpdateCheck Card Window Substance T) then (REDISPLAYW Window)")
Window])
(NC.MakeLinksLegendMenu
[LAMBDA (Win LabelPairs) (* ; "Edited 22-Jan-88 18:03 by Trigg")
(* ;; "Build a links legend menu and attach to Win")
(* ;; "rht 1/10/85: Before starting, kill any old links legend menus for Win.")
(* ;; "rht 1/13/86: Now holds onto value of PASSTOMAINCOMS windowprop of prompt win and restores after reattaching.")
(* ;; "rht 1/15/86: Added windowprops MINSIZE and MAXSIZE to fix the bug where reshaping browser screws up links legend menu.")
(* ;;
"rht 3/7/86: Now closes prompt window before attaching menu. Uses ATTACHMENU to attach the menu.")
(* ;; "rht 4/5/86: Took out call to NC.MoveWindowOntoScreen. For big browsers it causes redraw of window which is too high a price to pay.")
(* ;; "rht 3/20/87: Changed so that ATTACHMENU call is inside of NC.WithWindowsUnattached macro. Also took out closing of prompt window, as it's no longer necessary.")
(* ;;
"rht 1/16/88: Now does nothing if card has non-nil OmitLinksLegendFlg user data prop.")
(DECLARE (GLOBALVARS NC.LinkDashingInBrowser))
(OR (NCP.CardUserDataProp (NCP.WhichCard Win)
'OmitLinksLegendFlg)
(LET (Menu MenuWin PromptWin MainWinPromptInfo PromptWinPASSTOMAINCOMS)
(for AttachedWin in (ATTACHEDWINDOWS Win) when (WINDOWPROP AttachedWin 'LINKSLEGENDWINP)
do (REMOVEWINDOW AttachedWin))
[SETQ Menu (COND
(NC.LinkDashingInBrowser (create MENU
ITEMS ←
[for Pair in LabelPairs
join (LIST (CAR Pair)
(LIST '" "]
TITLE ← 'Links
MENUCOLUMNS ← 2))
(T (create MENU
ITEMS ← (for Pair in LabelPairs collect (CAR Pair))
TITLE ← 'Links
MENUCOLUMNS ← 1] (* ;
"Stick the links legend window at upper right corner.")
[NC.WithTopWindowsUnattached Win (SETQ MenuWin (ATTACHMENU Menu Win 'RIGHT 'TOP]
(* ;
"Rig so that close of menu won't close browser.")
(WINDOWDELPROP MenuWin 'PASSTOMAINCOMS 'CLOSEW)
(WINDOWADDPROP MenuWin 'CLOSEFN [FUNCTION (LAMBDA (W)
(DETACHWINDOW W]
T)
(WINDOWADDPROP MenuWin 'REPAINTFN 'NC.LinksLegendRepaintFn)
(WINDOWADDPROP MenuWin 'RESHAPEFN 'NC.LinksLegendReshapeFn)
(WINDOWADDPROP MenuWin 'LINKSLEGENDWINP T)
(WINDOWPROP Win 'NCLABELPAIRS LabelPairs)
(if NC.LinkDashingInBrowser
then (NC.LinksLegendRepaintFn MenuWin NIL])
(NC.BrowserRemoveNode
[LAMBDA (Graph Window DeleteCardFlg NodeToRemove QuietFlg) (* ; "Edited 22-Jan-88 18:04 by Trigg")
(* ;; "Called by grapher when user removes a node.")
(* ;; "rht 11/17/85: Updated to handle new card and notefile formats.")
(* ;; "rht 2/7/86: Changed to use NC.SetBrowserRoots instead of NC.PutProp")
(* ;; "rht 4/30/86: Now takes optional NodeToRemove and QuietFlg argument.")
(* ;; "rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard")
(* ;; "pmi 8/7/87: Now passes DeleteCardFlg arg to NC.DelBrowserContentsLink. Also turned off confirmation in NC.DeleteNoteCard.")
(* ;; "rht 1/19/88: Now returns nil if NC.SelectGraphNode returns nil.")
(DECLARE (GLOBALVARS PROMPTWINDOW))
(PROG ((GraphCard (NC.CoerceToCard Window))
Card NodeToRemoveID RootCards NodesToRemove NumVirtuals)
(OR NodeToRemove (SETQ NodeToRemove (NC.SelectGraphNode Window Graph
(if DeleteCardFlg
then "Choose node of card to delete."
else "Choose node to remove.")))
(RETURN NIL))
(SETQ NodeToRemoveID (NC.CoerceToGraphNodeIDOrLabel NodeToRemove))
(SETQ Card (NC.CardFromBrowserNodeID NodeToRemoveID))
(* ;; "If we're supposed to be deleting a card, then check that node represents a card and that user confirms.")
(if DeleteCardFlg
then (if (NC.ValidCardP Card)
then (if (NOT (NC.AskYesOrNo (CONCAT "Are you sure you want to delete the "
(NC.RetrieveTitle Card)
" card? ")
"--"
'Yes T Window NIL NIL))
then (FLIPNODE NodeToRemove Window)
(RETURN (NC.PrintMsg NIL T "Card & Node delete aborted.")))
else (NC.PrintMsg NIL T "No card for that node.")
(FLASHW PROMPTWINDOW)
(FLIPNODE NodeToRemove Window)
(RETURN NIL)))
(AND (NC.ValidCardP GraphCard)
(NC.MarkCardDirty GraphCard))
(* ;; "We require that all virtual nodes for this node must be removed at once if this one has any link edges to or from it.")
(SETQ NodesToRemove (for Node in (fetch (GRAPH GRAPHNODES) of Graph)
when (EQ NodeToRemoveID (NC.CoerceToGraphNodeIDOrLabel Node))
collect Node)) (* ;
"If there are no edges into or out of this node, then just delete from graph.")
(if (AND (NOT DeleteCardFlg)
(NULL (fetch (GRAPHNODE FROMNODES) of NodeToRemove))
(NULL (fetch (GRAPHNODE TONODES) of NodeToRemove)))
then (FLIPNODE NodeToRemove Window) (* ;
"Delete the browsercontents link from the browser.")
(if (AND (NC.ValidCardP Card)
(NC.ValidCardP GraphCard))
then (NC.DelBrowserContentsLink GraphCard Card)
(* ;
"Remove entry for this node from browser hash array.")
(NC.RemoveBrowserNodeHashArrayEntry GraphCard Card))
(RETURN (NC.GraphRemoveNode NodeToRemove Graph Window)))
(* ;
"If there are companion virtual nodes, ask for user confirmation.")
(if [AND (NOT DeleteCardFlg)
(GREATERP (SETQ NumVirtuals (LENGTH NodesToRemove))
1)
(NOT (PROGN (NC.PrintMsg Window T NumVirtuals
" virtual companion nodes will be removed." (CHARACTER 13))
(NC.YesP (NC.AskUser "Still want to remove? " "--" 'Yes NIL Window NIL
NIL T]
then (FLIPNODE NodeToRemove Window)
(RETURN NIL)) (* ;
"Delete the browsercontents link from the browser.")
(AND (NC.ValidCardP Card)
(NC.ValidCardP GraphCard)
(NC.DelBrowserContentsLink GraphCard Card DeleteCardFlg))
(* ;
"Delete all record of links to and from this node on prop lists.")
(NC.SmashGraphNodeIDProps NodeToRemoveID)
(for Node in (fetch (GRAPH GRAPHNODES) of Graph) eachtime (BLOCK) bind UID
when (type? UID (SETQ UID (NC.CoerceToGraphNodeID Node))) do (NC.GraphNodeIDRemProp
UID NodeToRemoveID))
(if (AND (NC.ValidCardP Card)
(NC.ValidCardP GraphCard))
then (* ; "Remove from the root ids list.")
(SETQ RootCards (NC.FetchBrowserRoots GraphCard))
(if (for RootCard in RootCards eachtime (BLOCK) thereis (NC.SameCardP Card
RootCard))
then (NC.SetBrowserRoots GraphCard (for RootCard in RootCards
eachtime (BLOCK)
unless (NC.SameCardP Card RootCard)
collect RootCard)))
(* ;
"Remove entry for this node from browser hash array.")
(NC.RemoveBrowserNodeHashArrayEntry GraphCard Card))
(* ;
"Get rid of node and its virtual buddies from graph.")
(AND Window (FLIPNODE NodeToRemove Window))
(for Node in NodesToRemove do (NC.GraphRemoveNode Node Graph Window))
(* ; "Delete card if we're supposed to.")
(if DeleteCardFlg
then (NC.PrintMsg NIL T "Deleting " Card " ... ")
(NC.DeleteNoteCard Card NIL T)
(NC.PrintMsg NIL T "Done." (CHARACTER 13)))
(AND Window (REDISPLAYW Window))
(OR QuietFlg (NC.PrintMsg NIL T "Nodes: " [CONCATLIST
(for Node in NodesToRemove
collect (PACK* (fetch (GRAPHNODE NODEID)
of Node)
'% ]
"removed."])
(NC.SelectGraphNode
[LAMBDA (Window Graph Mess) (* ; "Edited 22-Jan-88 18:04 by Trigg")
(* ;; "User selects a node from the browser. The node is inverted and returned.")
(* ;; "rht 1/19/88: Now prints message to window and also checks to make sure that cursor is inside region of node before pronouncing it a valid selection.")
(DECLARE (GLOBALVARS PROMPTWINDOW))
(RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(CLRPROMPT)
(PROG (NODE)
(COND
((NOT (fetch (GRAPH GRAPHNODES) of Graph))
(PROMPTPRINT " No nodes in graph.")
(RETURN)))
(NC.PrintMsg Window T Mess)
(SETQ NODE (READ/NODE (fetch (GRAPH GRAPHNODES) of Graph)
Window))
(NC.ClearMsg Window T)
(if (NC.CursorInsideGraphNodeP NODE Window)
then (FLIPNODE NODE Window)
(RETURN NODE)
else (RETURN NIL])
)
(* ;; "Changes to NCGRAPHCARD")
(DEFINEQ
(NC.GraphCardShrinkFn
[LAMBDA (W) (* ; "Edited 21-Jan-88 23:41 by Trigg")
(* ;;; "Check to make sure that icon's title agrees with card title. If not, retitle the icon. If this is first shrink then create a new icon and fill in title.")
(* ;; "rg 11/19/86 Added GLOBALVARS declaration")
(* ;; "rht 1/21/88: Now checks windowprop to see whether default shrunken icon template should be overridden.")
(DECLARE (GLOBALVARS TEDIT.ICON.FONT NC.ShrunkenGraphIconTemplate))
(LET ((OldIconTitle (WINDOWPROP W 'GRAPH.ICON.TITLE))
(Icon (WINDOWPROP W 'ICON))
(Card (NC.CoerceToCard W))
IconTitle BM IconTemplate BMHeight BMHalfHeight TitleRegion)
(SETQ IconTitle (CONCAT "NC: " (NC.RetrieveTitle Card)))
[COND
((NOT Icon)
(WINDOWPROP W 'ICON (SETQ Icon (TITLEDICONW (OR (WINDOWPROP W 'ShrunkenIconTemplate)
NC.ShrunkenGraphIconTemplate)
IconTitle TEDIT.ICON.FONT
(POSITIONP (WINDOWPROP W 'SHRUNKENWINPOS))
T]
(COND
((NOT (EQUAL OldIconTitle IconTitle))
(WINDOWPROP W 'GRAPH.ICON.TITLE IconTitle)
(ICONTITLE IconTitle TitleRegion NIL Icon])
)
(* ;; "Changes to NCLINKS")
(DEFINEQ
(NC.LinkIconMiddleButtonFn
[LAMBDA (LinkIcon Window) (* ; "Edited 23-Jan-88 20:44 by Trigg")
(* ;; "Middle button has been pressed in the Notecard link icon. Bring up menu of choices for manipulating this link icon.")
(* ;; "rht 11/18/86: Now calls NC.TraverseLink rather than NC.EditNoteCard.")
(* ;; "rht 2/4/87: Now checks the ExtraLinkIconMenuItems property of the destination's card type atom. If non-nil, then include those items in link icon menu.")
(* ;; "pmi 3/25/87: Added NC.MenuFont to all menus")
(* ;; "rht 1/16/88: If there are extra items for the menu, then add dashed line boundary to menu. Also now caches middle button menu on card type atom in the extra items case.")
(* ;; "rht 1/23/88: Now passes WIndow into the apply* for any extra link icon menu items.")
(DECLARE (GLOBALVARS NC.LinkIconMiddleButtonMenu NC.MenuFont))
(LET ((Card (fetch (Link DestinationCard) of (NC.FetchLinkFromLinkIcon LinkIcon)))
ExtraItems CardType Selection Menu CachedMenu)
(SETQ CardType (NC.RetrieveType Card))
(SETQ CachedMenu (GETPROP CardType 'LinkIconMiddleButtonMenu))
(SETQ ExtraItems (GETPROP CardType 'ExtraLinkIconMenuItems))
[COND
((type? MENU CachedMenu)
(SETQ Menu CachedMenu))
((AND (BOUNDP 'NC.LinkIconMiddleButtonMenu)
(type? MENU NC.LinkIconMiddleButtonMenu)
(NULL ExtraItems))
(SETQ Menu NC.LinkIconMiddleButtonMenu))
(T (SETQ Menu (create MENU
ITEMS ← (APPEND '((|Bring Up Card/Box| 'Edit
"Bring up the note card pointed to by this pointer."
)
(|Change Link Type| 'Relabel
"Change the label of this pointer.")
(|Change Card Title| 'Retitle
"Change the destination card's title.")
(|Change Display Mode| 'Display
"Change the type of information displayed in this pointer."
)) [if ExtraItems
then '((------ NIL ""]
ExtraItems)
CENTERFLG ← T
TITLE ← "Link Ops"
MENUFONT ← NC.MenuFont
ITEMHEIGHT ← (IPLUS (FONTPROP NC.MenuFont 'HEIGHT)
1)))
(if ExtraItems
then (PUTPROP CardType 'LinkIconMiddleButtonMenu Menu)
else (SETQ NC.LinkIconMiddleButtonMenu Menu]
(if (NC.CardP (NC.CoerceToCard Window))
then (SELECTQ (SETQ Selection (MENU Menu))
(Edit (NC.TraverseLink LinkIcon Window))
(Display (NC.ChangeLinkDisplayMode LinkIcon Window))
(Relabel (NC.RelabelLink LinkIcon Window))
(Retitle (NC.ChangeCardTitleFromLinkIcon LinkIcon Window))
(NIL NIL)
(ADD.PROCESS `(APPLY* ',Selection ',Card ',Window) 'NAME 'LinkIconMiddleButton)
)
else NIL])
(NC.DrawLinkOrPointerIcon
[LAMBDA (ImageStream ImageBox LinkIconString AttachBitmapFlg Card PointerStyleFlg
BorderWidthIncrement) (* ; "Edited 21-Jan-88 18:19 by Trigg")
(* ;;; "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.")
(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 FontHeight FontAscent FontDescent Left Bottom Top CrossFileLinkFlg
CrossFileLinkDestCard ActualCard Icon SavedIcon CrossFileLinkIcon LinkIconStrings
ApproxBoxWidth ApproxBoxHeight 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 FontHeight (FONTHEIGHT Font))
(* ;;; "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)
(if (SETQ CrossFileLinkDestCard (NCP.GetCrossFileLinkDestCard Card NIL T)
)
then (SETQ ActualCard CrossFileLinkDestCard)
else (SETQ ActualCard NIL))
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 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.FetchCrossFileLinkIconAttachedBitMap Card
CrossFileLinkDestCard 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 0))
ScaledLinkIconMaxWidth))
then
(* ;; "If the width of the icon 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 SavedIcon
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 ScaledIconWidth ScaledSpaceInnerX ScaledSpaceInnerX)
ScaledLinkIconMaxWidth))
then
(* ;; "Put out the icon bitmap, but only if the width of the icon 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)
(SETQ FontDescent (FONTDESCENT Font))
(if LinkIconStrings
then (if (GREATERP (LENGTH LinkIconStrings)
1)
then (SETQ FontAscent (FONTASCENT Font))
(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 21-Jan-88 18:30 by Trigg")
(* ;;; "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.")
(DECLARE (GLOBALVARS NC.LinkIconMultiLineMode NC.LinkIconMaxWidth NC.LinkIconBorderWidth
NC.LinkIconSpaceInnerX NC.LinkIconSpaceOuterX NC.LinkIconSpaceInnerY
NC.LinkIconSpaceOuterY NC.LinkIconSpaceInterLine))
(LET ((Scale (DSPSCALE NIL ImageStream))
(StringWidth 0)
(Font (DSPFONT NIL ImageStream))
CrossFileLinkFlg CrossFileLinkDestCard ActualCard Icon SavedIcon CrossFileLinkIcon
FontHeight ApproxBoxWidth LinkIconStrings ScaledIconHeight ScaledIconWidth NumberOfLines
XSize YSize ScaledLinkIconMaxWidth ScaledBorderWidth ScaledSpaceInnerX ScaledSpaceOuterX
ScaledSpaceInnerY ScaledSpaceOuterY ScaledSpaceInterLine HalfScaledSpaceInterLine
TotalEdgeSpaceY)
(SETQ FontHeight (FONTHEIGHT 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)
(if (SETQ CrossFileLinkDestCard (NCP.GetCrossFileLinkDestCard Card NIL T))
then (SETQ ActualCard CrossFileLinkDestCard)
else (SETQ ActualCard NIL))
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 ScaledBorderWidth ScaledSpaceInnerX
(STRINGWIDTH LinkIconString Font)
ScaledSpaceInnerX ScaledBorderWidth))
(* ;;; "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 0))
ScaledLinkIconMaxWidth))
then (* ;
"Now it doesn't fit. Calculate Multi-line icon")
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth
ScaledSpaceInnerY FontHeight
HalfScaledSpaceInterLine))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard
ScaledIconHeight 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.FetchCrossFileLinkIconAttachedBitMap Card
CrossFileLinkDestCard 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 outer x's.")
(SETQ XSize (PLUS ScaledLinkIconMaxWidth ScaledSpaceOuterX ScaledSpaceOuterX))
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 SavedIcon
CrossFileLinkIcon ImageStream))
(if LinkIconStrings
then (SETQ NumberOfLines (LENGTH LinkIconStrings))
[if (GREATERP NumberOfLines 1)
then (SETQ StringWidth (PLUS (STRINGWIDTH (CAR LinkIconStrings)
Font)
ScaledIconWidth
(if CrossFileLinkIcon
then ScaledIconWidth
else 0)))
(* ;
"Find the longest string for the width of the box")
(for String in (CDR LinkIconStrings) bind PartStringWidth
when (GREATERP (SETQ PartStringWidth (STRINGWIDTH String Font))
StringWidth) do (SETQ StringWidth PartStringWidth))
(SETQ YSize (PLUS TotalEdgeSpaceY TotalEdgeSpaceY (TIMES
NumberOfLines
FontHeight
)
(TIMES (SUB1 NumberOfLines)
ScaledSpaceInterLine)))
else (SETQ StringWidth (PLUS (STRINGWIDTH (CAR LinkIconStrings)
Font)
ScaledIconWidth
(if CrossFileLinkIcon
then ScaledIconWidth
else 0]
(SETQ XSize (MIN (PLUS StringWidth ScaledSpaceOuterX ScaledSpaceOuterX
ScaledSpaceInnerX ScaledSpaceInnerX
(if Icon
then (if CrossFileLinkIcon
then 0
else ScaledBorderWidth)
else (PLUS ScaledBorderWidth ScaledBorderWidth)))
(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])
(NC.LinkIconDisplayFn
[LAMBDA (ImageObj ImageStream StreamType TextStream Scale) (* ; "Edited 21-Jan-88 18:23 by Trigg")
(* ;;; "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/86: Fixed improperly placed comment.")
(* ;; "pmi 2/11/87: Overhauled to accommodate multi-line link icons")
(* ;; "pmi 2/27/87: Fixed problems with only displaying the attached bitmap and with displaying null titles")
(* ;; "pmi 5/1/87: added missing local vars declarations.")
(* ;; "pmi&rht 6/19/87: Added check for bad link (ie: half link to a deleted card.) Such a link will now be deleted and its image object replaced with a 'Bad Link' object.")
(* ;; "rht 10/24/87: Ripped out heart of this function and moved to NC.DrawLinkOrPointerIcon. In the case when there is no stored ImageBox on the Imageobj, it was doing the calculation twice, once here and then again when the ImageBoxFn is called. Now just calls the ImageBoxFn if necessary up front.")
(* ;; "rht 1/21/88: Now passes extra BorderWidthIncrement argument to NC.DrawLinkOrPointerIcon which it grabs off IMAGEOBJPROP.")
(DECLARE (GLOBALVARS NC.LinkIconAttachBitmapFlg NC.LinkIconShowLinkTypeFlg
NC.LinkIconShowTitleFlg))
(RESETLST [RESETSAVE NIL `(DSPFONT ,(DSPFONT NC.LinkIconFont ImageStream) ,ImageStream]
(PROG ((Scale (DSPSCALE NIL ImageStream))
(Link (NC.FetchLinkFromLinkIcon ImageObj))
ShowTitleFlg ShowLinkTypeFlg AttachBitmapFlg DisplayType Card Title Label
LinkIconString)
(* ;; "Check for bad Link")
(if [NOT (AND (NC.ValidCardP (fetch (Link SourceCard) of Link))
(NC.ValidCardP (fetch (Link DestinationCard) of Link]
then
(* ;; "Delete the offending link, smash its image object into a 'Deleted' image object, and return by displaying it.")
(NC.DeleteBadLink Link ImageObj ImageStream StreamType TextStream Scale)
(RETURN))
(* ;; "Link is okay, continue")
(* ;; "Determine what type of Display to do")
(SETQ DisplayType (fetch (Link DisplayMode) of Link))
(SETQ ShowTitleFlg (fetch (LINKDISPLAYMODE SHOWTITLEFLG) of DisplayType))
(SETQ Card (if (EQ ShowTitleFlg 'SOURCE)
then (fetch (Link SourceCard) of Link)
else (fetch (Link DestinationCard) of Link)))
(SETQ ShowLinkTypeFlg (fetch (LINKDISPLAYMODE SHOWLINKTYPEFLG) of DisplayType))
(SETQ AttachBitmapFlg (fetch (LINKDISPLAYMODE ATTACHBITMAPFLG) of DisplayType))
(if (EQ AttachBitmapFlg 'FLOAT)
then (SETQ AttachBitmapFlg NC.LinkIconAttachBitmapFlg))
(* ;; "Construct the text for the link icon")
(SETQ Title (if (AND ShowTitleFlg (OR (NEQ ShowTitleFlg 'FLOAT)
NC.LinkIconShowTitleFlg))
then (NC.RetrieveTitle Card)
else NIL))
(SETQ Label (AND (COND
((EQ ShowLinkTypeFlg 'FLOAT)
NC.LinkIconShowLinkTypeFlg)
(T ShowLinkTypeFlg))
(fetch (Link Label) of Link)))
(SETQ LinkIconString (CONCAT (COND
(Label (CONCAT "<" Label ">"))
(T ""))
(COND
((AND Label Title)
" ")
(T ""))
(OR Title "")))
(* ;; "Now do all the hard work.")
(NC.DrawLinkOrPointerIcon ImageStream
(OR (IMAGEOBJPROP ImageObj 'BOUNDBOX)
(NC.LinkIconImageBoxFn ImageObj ImageStream NIL NIL NIL DisplayType Title
Label LinkIconString))
LinkIconString AttachBitmapFlg Card NIL (IMAGEOBJPROP ImageObj '
BorderWidthIncrement])
(NC.LinkIconImageBoxFn
[LAMBDA (ImageObj ImageStream CurrentX RightMargin DummyArg DisplayType Title Label LinkIconString)
(* ; "Edited 21-Jan-88 18:30 by Trigg")
(* ;; "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.")
(* ;; "rg 11/18/86: Added TotalEdgeSpaceY to local vars declaration")
(* ;; "pmi 2/6/87: Overhauled to accommodate multi-line link icons")
(* ;; "pmi 2/27/87: Fixed problems with only displaying the attached bitmap and with displaying null titles")
(* ;; "pmi 5/1/87: added missing local vars declarations.")
(* ;; "pmi&rg 7/15/87 recreated peggy's patch to deal w/ links to deleted cards")
(* ;; "rht 10/24/87: Ripped out heart of code and put in NC.ComputeLinkOrPointerImageBox. Removed Icon and LinkIconStrings args as both were being computed here anyway.")
(* ;; "rht 1/21/88: Now passes extra BorderWidthIncrement argument to NC.ComputeLinkOrPointerImageBox which it grabs off IMAGEOBJPROP.")
(DECLARE (GLOBALVARS NC.LinkIconAttachBitmapFlg NC.LinkIconShowLinkTypeFlg
NC.LinkIconShowTitleFlg))
(RESETLST [RESETSAVE NIL `(DSPFONT ,(DSPFONT NC.LinkIconFont ImageStream) ,ImageStream]
(PROG ((Link (NC.FetchLinkFromLinkIcon ImageObj))
Card ShowTitleFlg AttachBitmapFlg ShowLinkTypeFlg)
(* ;; "Check for bad Link")
(if [NOT (AND (NC.ValidCardP (fetch (Link SourceCard) of Link))
(NC.ValidCardP (fetch (Link DestinationCard) of Link]
then
(* ;; "Delete the offending link, smash its image object into a 'Deleted' image object, and return by displaying it.")
(RETURN (NC.DeletedLinkImageBoxFn ImageObj ImageStream)))
(* ;; "Determine what type of Display to do")
(OR DisplayType (SETQ DisplayType (fetch (Link DisplayMode) of Link)))
(SETQ ShowTitleFlg (fetch (LINKDISPLAYMODE SHOWTITLEFLG) of DisplayType))
(SETQ Card (if (EQ ShowTitleFlg 'SOURCE)
then (fetch (Link SourceCard) of Link)
else (fetch (Link DestinationCard) of Link)))
(SETQ ShowLinkTypeFlg (fetch (LINKDISPLAYMODE SHOWLINKTYPEFLG) of DisplayType))
(SETQ AttachBitmapFlg (fetch (LINKDISPLAYMODE ATTACHBITMAPFLG) of DisplayType))
(SETQ AttachBitmapFlg (if (EQ AttachBitmapFlg 'FLOAT)
then NC.LinkIconAttachBitmapFlg
else AttachBitmapFlg))
(* ;; "Construct the text for the link icon")
[if (NOT LinkIconString)
then (OR Title (SETQ Title (if (AND ShowTitleFlg (OR (NEQ ShowTitleFlg
'FLOAT)
NC.LinkIconShowTitleFlg))
then (NC.RetrieveTitle Card)
else NIL)))
[OR Label (SETQ Label (AND (if (EQ ShowLinkTypeFlg 'FLOAT)
then NC.LinkIconShowLinkTypeFlg
else ShowLinkTypeFlg)
(fetch (Link Label) of Link]
(SETQ LinkIconString (CONCAT (COND
(Label (CONCAT "<" Label ">"))
(T ""))
(COND
((AND Label Title)
" ")
(T ""))
(OR Title ""]
(* ;; "Now do the hard work.")
(RETURN (NC.ComputeLinkOrPointerImageBox ImageStream LinkIconString AttachBitmapFlg
Card RightMargin (IMAGEOBJPROP ImageObj 'BorderWidthIncrement])
(NC.PointerIconDisplayFn
[LAMBDA (ImageObj ImageStream StreamType TextStream Scale) (* ; "Edited 21-Jan-88 18:32 by Trigg")
(* ;;; "Display a pointer icon")
(* ;; "rht 1/21/88: Now passes extra BorderWidthIncrement argument to NC.DrawLinkOrPointerIcon which it grabs off IMAGEOBJPROP.")
(DECLARE (GLOBALVARS NC.LinkIconAttachBitmapFlg NC.LinkIconShowLinkTypeFlg
NC.LinkIconShowTitleFlg))
(RESETLST [RESETSAVE NIL `(DSPFONT ,(DSPFONT NC.LinkIconFont ImageStream) ,ImageStream]
(PROG ((Scale (DSPSCALE NIL ImageStream))
(Pointer (NC.FetchPointerFromPointerIcon ImageObj))
Card ShowTitleFlg ShowLinkTypeFlg AttachBitmapFlg DisplayType Title Label
LinkIconString)
(* ;; "Check for bad Pointer")
(if [NOT (NC.ValidCardP (SETQ Card (fetch (NCPointer DestinationCard) of Pointer]
then
(* ;; "Delete the offending link, smash its image object into a 'Deleted' image object, and return by displaying it.")
(NC.DeleteBadPointer Pointer ImageObj ImageStream StreamType TextStream
Scale)
(RETURN))
(* ;; "Pointer is okay, continue")
(* ;; "Determine what type of Display to do")
(SETQ DisplayType (fetch (NCPointer DisplayMode) of Pointer))
(SETQ ShowTitleFlg (fetch (LINKDISPLAYMODE SHOWTITLEFLG) of DisplayType))
(SETQ ShowLinkTypeFlg (fetch (LINKDISPLAYMODE SHOWLINKTYPEFLG) of DisplayType))
(SETQ AttachBitmapFlg (fetch (LINKDISPLAYMODE ATTACHBITMAPFLG) of DisplayType))
(if (EQ AttachBitmapFlg 'FLOAT)
then (SETQ AttachBitmapFlg NC.LinkIconAttachBitmapFlg))
(* ;; "Construct the text for the link icon")
(SETQ Title (if (AND ShowTitleFlg (OR (NEQ ShowTitleFlg 'FLOAT)
NC.LinkIconShowTitleFlg))
then (NC.RetrieveTitle Card)
else NIL))
(SETQ Label (AND (COND
((EQ ShowLinkTypeFlg 'FLOAT)
NC.LinkIconShowLinkTypeFlg)
(T ShowLinkTypeFlg))
(fetch (NCPointer Label) of Pointer)))
(SETQ LinkIconString (CONCAT (COND
(Label (CONCAT "<" Label ">"))
(T ""))
(COND
((AND Label Title)
" ")
(T ""))
(OR Title "")))
(* ;; "Now do all the hard work.")
(NC.DrawLinkOrPointerIcon ImageStream
(OR (IMAGEOBJPROP ImageObj 'BOUNDBOX)
(NC.LinkIconImageBoxFn ImageObj ImageStream NIL NIL NIL DisplayType Title
Label LinkIconString))
LinkIconString AttachBitmapFlg Card T (IMAGEOBJPROP ImageObj '
BorderWidthIncrement])
(NC.PointerIconImageBoxFn
[LAMBDA (ImageObj ImageStream CurrentX RightMargin DummyArg DisplayType Title Label LinkIconString)
(* ; "Edited 21-Jan-88 18:34 by Trigg")
(* ;;; "Compute the image box for pointer icon.")
(* ;; "rht 1/21/88: Now passes extra BorderWidthIncrement argument to NC.ComputeLinkOrPointerImageBox which it grabs off IMAGEOBJPROP.")
(DECLARE (GLOBALVARS NC.LinkIconShowLinkTypeFlg NC.LinkIconShowTitleFlg
NC.LinkIconAttachBitmapFlg))
(RESETLST [RESETSAVE NIL `(DSPFONT ,(DSPFONT NC.LinkIconFont ImageStream) ,ImageStream]
(PROG ((Pointer (NC.FetchPointerFromPointerIcon ImageObj))
Card ShowTitleFlg AttachBitmapFlg ShowLinkTypeFlg)
(* ;; "Check for bad Pointer")
(if [NOT (NC.ValidCardP (SETQ Card (fetch (NCPointer DestinationCard) of Pointer]
then
(* ;; "Delete the offending link, smash its image object into a 'Deleted' image object, and return by displaying it.")
(RETURN (NC.DeletedLinkImageBoxFn ImageObj ImageStream)))
(* ;; "Determine what type of Display to do")
(OR DisplayType (SETQ DisplayType (fetch (NCPointer DisplayMode) of Pointer)))
(SETQ ShowTitleFlg (fetch (LINKDISPLAYMODE SHOWTITLEFLG) of DisplayType))
(SETQ ShowLinkTypeFlg (fetch (LINKDISPLAYMODE SHOWLINKTYPEFLG) of DisplayType))
(SETQ AttachBitmapFlg (fetch (LINKDISPLAYMODE ATTACHBITMAPFLG) of DisplayType))
(SETQ AttachBitmapFlg (if (EQ AttachBitmapFlg 'FLOAT)
then NC.LinkIconAttachBitmapFlg
else AttachBitmapFlg))
(* ;; "Construct the text for the link icon")
[if (NOT LinkIconString)
then (OR Title (SETQ Title (if (AND ShowTitleFlg (OR (NEQ ShowTitleFlg
'FLOAT)
NC.LinkIconShowTitleFlg))
then (NC.RetrieveTitle Card)
else NIL)))
[OR Label (SETQ Label (AND (if (EQ ShowLinkTypeFlg 'FLOAT)
then NC.LinkIconShowLinkTypeFlg
else ShowLinkTypeFlg)
(fetch (NCPointer Label) of Pointer]
(SETQ LinkIconString (CONCAT (COND
(Label (CONCAT "<" Label ">"))
(T ""))
(COND
((AND Label Title)
" ")
(T ""))
(OR Title ""]
(* ;; "Now do the hard work.")
(RETURN (NC.ComputeLinkOrPointerImageBox ImageStream LinkIconString AttachBitmapFlg
Card RightMargin (IMAGEOBJPROP ImageObj 'BorderWidthIncrement])
)
(* ;; "Change to NCPROGINT")
(DEFINEQ
(NCP.SelectCards
[LAMBDA (InstigatingCardOrWindow SingleCardFlg SelectionPredicate Msg CheckForCancelFlg)
(* ; "Edited 14-Jan-88 23:06 by Trigg")
(* ;; "Return a list of cards selected. A menu pops up near the prompt window with 'DONE' and 'CANCEL' buttons. User selects by clicking in card's title bar.")
(* ;; "rht 11/18/85: Updated to handle new notefile and card object formats. Now takes optional extra args and passes to NC.SelectNoteCards.")
(* ;;
"pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.")
(* ;; "rht 3/2/87: Fix to bug #342: Now makes sure instigating card is displayed, else passes NIL to NC.SelectNoteCards.")
(* ;; "rg 4/2/87 added NCP.WithLockedCards wrapper")
(* ;; "rht 1/14/88: Now passes value of NC.CoerceToInterestedWindow to NC.SelectNoteCards.")
(NCP.WithLockedCards (NC.SelectNoteCards SingleCardFlg SelectionPredicate
(if SingleCardFlg
then NC.SelectingCardMenu
else NC.SelectingCardsMenu)
(NC.CoerceToInterestedWindow InstigatingCardOrWindow)
Msg CheckForCancelFlg])
)
(PUTPROPS RHTPATCH304 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2466 3744 (NC.CursorInsideGraphNodeP 2476 . 3340) (NC.CardFromBrowserNode 3342 . 3742))
(3787 38706 (NC.BrowserFixGraphEditMenuFn 3797 . 5454) (NC.GetGraphEditMenu 5456 . 8139) (
NC.BrowserAddLink 8141 . 16950) (NC.BrowserCreateLink 16952 . 19174) (NC.BrowserCardQuitFn 19176 .
19940) (NC.BringUpBrowserCard 19942 . 26216) (NC.MakeLinksLegendMenu 26218 . 29680) (
NC.BrowserRemoveNode 29682 . 37541) (NC.SelectGraphNode 37543 . 38704)) (38747 40253 (
NC.GraphCardShrinkFn 38757 . 40251)) (40290 91003 (NC.LinkIconMiddleButtonFn 40300 . 44107) (
NC.DrawLinkOrPointerIcon 44109 . 58585) (NC.ComputeLinkOrPointerImageBox 58587 . 72112) (
NC.LinkIconDisplayFn 72114 . 77963) (NC.LinkIconImageBoxFn 77965 . 83670) (NC.PointerIconDisplayFn
83672 . 87321) (NC.PointerIconImageBoxFn 87323 . 91001)) (91041 92515 (NCP.SelectCards 91051 . 92513))
)))
STOP