(FILECREATED "29-Mar-86 20:47:48" {QV}<NOTECARDS>RELEASE1.2I>POSTRELEASEPATCHES.;5 29525
changes to: (VARS POSTRELEASEPATCHESCOMS)
previous date: "28-Mar-86 18:24:08" {QV}<NOTECARDS>RELEASE1.2I>POSTRELEASEPATCHES.;4)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT POSTRELEASEPATCHESCOMS)
(RPAQQ POSTRELEASEPATCHESCOMS ((* * Prevent DB File from being closed during CLOSEALL)
(FNS NC.OpenDatabaseFile)
(* * rht 1/27/86: Fix for browser bug reported by Cathy: can't pass
linktypes parameter to NCP.CreateBrowserCard)
(FNS NC.MakeBrowserCard NC.MakeLinksLegendMenu NCP.CreateBrowserCard
NCP.MakeBrowser)
(* * rht 1/27/86: Fix for bug reported by Lissa: Back links in
LinkIndex cards are broken.)
(FNS NC.AppendLinkIndexEntry)
(* * rht 1/31/86: Fix for bug reported by Cathy where NCP.ChangeLoc
ignores numeric Loc argument.)
(FNS NCP.ChangeLoc)
(* * rht 3/28/86: Code to do browser overviews.)
(FILES (FROM VALUEOF NOTECARDSDIRECTORIES)
BROWSEROVERVIEWPATCH)
(* * kirk 29Mar86 Dave Newman's patch for the sketch link duplicates
bug)
(FNS NC.LinkIconWhenMovedFn)))
(* * Prevent DB File from being closed during CLOSEALL)
(DEFINEQ
(NC.OpenDatabaseFile
(LAMBDA (FileName Access NoSetFlg QuietFlg Don'tCreateFlg Convertw/oConfirmFlg Don'tCreateArrayFlg
Don'tTruncateFlg) (* fgh: "16-Dec-85 10:59")
(* Open an already existing database file.)
(* * rht 8/7/84: For nonexistent files, asks user whether to create unless Don'tCreateFlg is non-nil.)
(* * rht 1/9/85: Checks NC.UncachingNotCompleted global var. If non-nil, then previous notefile died unnaturally,
so we first clear junk off the IDs.)
(* * rht 8/6/85: Added Don'tTruncateFlg, which, if on, prevents the check for truncation.)
(* * fgh 12/16/85 Put in call to WHENCLOSE to protect Database stream from CLOSEALL)
(PROG (Name Stream NewStream ID CardTotal)
(OR Access (SETQ Access (QUOTE BOTH)))
(COND
((AND PSA.Database (OPENP PSA.Database))
(NC.PrintMsg NIL T "There is already an open NoteFile -- " (FULLNAME PSA.Database)
(CHARACTER 13)
"It must be closed before a new one" " can be opened." (CHARACTER
13))
(RETURN NIL)))
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName "Name of NoteFile to open:" " -- "
T)))
(RETURN NIL))
(COND
((OPENP FileName)
(NC.PrintMsg NIL T FileName " is an already open file." (CHARACTER 13))
(RETURN)))
(AND (NOT (SETQ Name (INFILEP FileName)))
(COND
(Don'tCreateFlg (NC.PrintMsg NIL T "Couldn't find NoteFile " FileName "."
(CHARACTER 13))
(RETURN NIL))
((NC.YesP (NC.AskUser (CONCAT "Unable to find NoteFile " FileName "."
(CHARACTER 13)
"Want to create new NoteFile by that name? ")
" -- " "Yes" T NIL T NIL T))
(NC.CreateDatabaseFile FileName NIL "Opening NoteFile" T)
(AND (NOT (SETQ Name (INFILEP FileName)))
(NC.PrintMsg NIL T "Still unable to find Notefile " FileName "."
(CHARACTER 13))
(RETURN NIL)))
(T (RETURN NIL))))
(COND
(NC.UncachingNotCompleted (NC.ClearIDAtoms NC.UncachingNotCompleted)))
(AND (NULL QuietFlg)
(NC.PrintMsg NIL T "Opening ... " (CHARACTER 13)))
(SETQ Stream (OPENSTREAM Name Access (QUOTE OLD)))
(NC.SetMonitor Stream (CREATE.MONITORLOCK (MKATOM (CONCAT Name ":LOCK"))))
(SETFILEPTR Stream 0)
(STREAMPROP Stream (QUOTE NCNEXTIDNUM)
(NC.GetPtr Stream 2))
(COND
((NULL (SETQ NewStream (NC.CheckForNeededConversion Stream Access
Convertw/oConfirmFlg)))
(CLOSEF Stream)
(RETURN NIL))
(T (NC.SetMonitor NewStream (NC.FetchMonitor Stream))
(SETQ Stream NewStream)))
(if (AND (NULL Don'tTruncateFlg)
(SETQ NewStream (NC.CheckForNeededTruncation Stream Access)))
then (* Can either bail out entirely or run inspector and
then bail out.)
(SELECTQ NewStream
(ABORT (CLOSEF Stream)
(RETURN NIL))
(ABORTANDINSPECT (CLOSEF Stream)
(NC.ScavengerPhase1 Name)
(RETURN NIL))
NIL))
(COND
(NewStream (NC.SetMonitor NewStream (NC.FetchMonitor Stream))
(SETQ Stream NewStream)))
(SETFILEPTR Stream 0)
(STREAMPROP Stream (QUOTE NCNEXTIDNUM)
(NC.GetPtr Stream 2))
(SETTOPVAL (QUOTE NC.IndexSizeInEntries)
(NC.GetPtr Stream 2))
(STREAMPROP Stream (QUOTE NCNEXTLINKID)
(NC.GetPtr Stream))
(OR Don'tCreateArrayFlg (NC.BuildIndexArray Stream))
(COND
((NULL NoSetFlg)
(SETQ PSA.Database Stream) (* Cache all of the titles in this database)
(NC.CacheTypesAndTitles PSA.Database NIL QuietFlg "Opening NoteFile.")
(NC.SetMainMenuTitle Stream)))
(AND (NULL QuietFlg)
(NC.PrintMsg NIL T "Opened " (FULLNAME Stream)
(CHARACTER 13)))
(* * Prevent stream from being closed by CLOASEALL)
(WHENCLOSE Stream (QUOTE CLOSEALL)
(QUOTE NO))
(RETURN Stream))))
)
(* * rht 1/27/86: Fix for browser bug reported by Cathy: can't pass linktypes parameter to
NCP.CreateBrowserCard)
(DEFINEQ
(NC.MakeBrowserCard
(LAMBDA (ID Title NoDisplayFlg ParamList) (* rht: "27-Jan-86 12:45")
(* Make a browser card with id ID using root at RootID and the link following predictae specified by Predicate.
IF Root and/or ListOfLinkLabels not specified, ask the user.)
(* * rht 8/3/84: Changed to call NC.AskLinkLabel with its ReverseLinkLabel parameter set to T.)
(* * fgh 10/2/84 Changed Link Icons to be image objects in NodeLabel of Graph Npodes rather than annotations on
graph nodes.)
(* * rht 10/19/84: Fixed setting up of browser card's prop list in case NoDisplayFlg is T so we have no Window.
Now NC.MakeLinksLegend returns the label pairs.)
(* * rht 11/27/84: Removed the WINDOWADDPROP call to put NC.GraphCardCloseFn on the CLOSEFN of the window.
This causes trouble. NC.QuitCard will get put on by NC.MakeNoteCard and that's enough.)
(* * rht 1/3/85: Now puts a dummy region of the right size if the NoDisplayFlg is on.)
(* * rht 1/15/85: Put hooks for AddNode, AddLink, etc. so editing graph edits underlying structure.)
(* * rht 2/14/85: Added VerticalFlg and made BrowserSpecs get put on browser's proplist in all cases.)
(* * rht 4/1/85: Now calls NC.AskBrowserSpecs with additional Don'tAskFlg in case of call from Programmer's
interface.)
(PROG (Lattice Window Graph PropList SpecialBrowserSpecs (RootIDs (MKLIST
(LISTGET ParamList
(QUOTE
ROOTCARDS))))
RootNodes
(ListOfLinkLabels (LISTGET ParamList (QUOTE LINKTYPES)))
(BrowserFormat (LISTGET ParamList (QUOTE FORMAT)))
(Depth (LISTGET ParamList (QUOTE DEPTH)))
LabelPairs BrowserSpecs DropVirtualNodesFlg)
(NC.ActivateCard ID)
(COND
((NULL NoDisplayFlg)
(SETQ Window (CREATEW (NC.DetermineDisplayRegion ID NIL)
(NC.FetchTitle ID)
NIL))
(WINDOWADDPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.GraphCardShrinkFn))
(WINDOWPROP Window (QUOTE NoteCardID)
ID)))
(if (NULL RootIDs)
then (SETQ RootIDs (if NoDisplayFlg
then (LIST NIL)
else (NC.SelectNoteCards NIL NIL
NC.SelectingBrowserSourceMenu
Window NIL
"Please select the Cards and/or Boxes the browser should start from."
T))))
(COND
((EQ RootIDs (QUOTE CANCELLED))
(NC.DeactivateCard ID)
(CLOSEW Window)
(RETURN)))
(NC.HoldTTYProcess)
(SETQ BrowserSpecs (NC.AskBrowserSpecs Window ListOfLinkLabels Depth BrowserFormat T
(if (OR ParamList NoDisplayFlg)
then (QUOTE DONTASK))))
(COND
((NULL BrowserSpecs)
(NC.DeactivateCard ID)
(CLOSEW Window)
(RETURN)))
(SETQ ListOfLinkLabels (CAR BrowserSpecs))
(SETQ Depth (CADR BrowserSpecs))
(SETQ BrowserFormat (CADDR BrowserSpecs)) (* If user wants *GRAPH* format, i.e. virtual nodes
eliminated, then set the flag)
(if (FMEMB NC.*Graph*BrowserFormat BrowserFormat)
then (SETQ DropVirtualNodesFlg T))
(SETQ SpecialBrowserSpecs (COND
(NC.SpecialBrowserSpecsFlg (NC.AskSpecialBrowserSpecs Window))
(T (create SPECIALBROWSERSPECS))))
(OR NoDisplayFlg (NC.PrintMsg Window T (CHARACTER 13)
"Computing browser graph. Please wait. ..."))
(* Compute lattice breakdth-first starting from
roots.)
(SETQ Lattice (NC.GrowLinkLattice RootIDs NIL ListOfLinkLabels ID PSA.Database Depth))
(SETQ RootNodes (for RootID in RootIDs collect (PACK* ID RootID)))
(OR NoDisplayFlg (WINDOWPROP Window (QUOTE NoteCardID)
ID))
(* * Link destination id information stored in NodeLabel field into a LinkIcon for display)
(for Node in Lattice bind NodeID eachtime (BLOCK)
do (replace (GRAPHNODE NODELABEL) of Node
with (NC.MakeLinkIcon (NC.MakeLink Window NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE NODELABEL)
of Node)
ID NIL)))
(* Untouch each graph node so that next Recompute will
put fresh values on proplist.)
(SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
(REMPROP (OR (CAR NodeID)
NodeID)
(QUOTE TouchedFlg))
(REMPROP (OR (CAR NodeID)
NodeID)
(QUOTE VisitedFlg)))
(SETQ Graph (if (AND Lattice RootNodes)
then (LAYOUTGRAPH Lattice RootNodes (SUBST (QUOTE LATTICE)
NC.*Graph*BrowserFormat
BrowserFormat)
(fetch (SPECIALBROWSERSPECS Font) of
SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS MotherD)
of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS PersonalD)
of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS FamilyD)
of SpecialBrowserSpecs))
else (create GRAPH)))
(SETQ LabelPairs (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(OR NoDisplayFlg (NC.PrintMsg Window NIL "Done!"))
(NC.SetSubstance ID Graph)
(NC.PutProp ID (QUOTE BrowserLinkLabels)
(LIST (OR ListOfLinkLabels NC.SubBoxLinkLabel)))
(NC.PutProp ID (QUOTE BrowserRoots)
(LIST RootIDs))
(NC.PutProp ID (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(NC.PutProp ID (QUOTE BrowserFormat)
(LIST BrowserFormat))
(NC.PutProp ID (QUOTE BrowserDepth)
Depth)
(NC.PutProp ID (QUOTE SpecialBrowserSpecs)
(LIST SpecialBrowserSpecs))
(NC.SetPropListDirtyFlg ID T)
(COND
(NoDisplayFlg (RETURN ID)))
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.SetupTitleBarMenu Window ID (QUOTE Browser))
(NC.RelayoutBrowserCard Window)
(RETURN Window))))
(NC.MakeLinksLegendMenu
(LAMBDA (Win LabelPairs) (* rht: "27-Jan-86 12:39")
(* * 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.)
(PROG (Menu MenuWin PromptWin MainWinPromptInfo PromptWinPASSTOMAINCOMS)
(for AttachedWin in (ATTACHEDWINDOWS Win) when (WINDOWPROP AttachedWin
(QUOTE
LINKSLEGENDWINP))
do (CLOSEW AttachedWin))
(SETQ Menu (COND
(NC.LinkDashingInBrowser (create MENU
ITEMS ←(for Pair in LabelPairs
join (LIST (CAR Pair)
(LIST (QUOTE " "))))
TITLE ←(QUOTE Links)
MENUCOLUMNS ← 2))
(T (create MENU
ITEMS ←(for Pair in LabelPairs collect (CAR Pair))
TITLE ←(QUOTE Links)
MENUCOLUMNS ← 1)))) (* Detach the prompt window for a second, saving the
prompt window info from the main win's props.)
(if (SETQ PromptWin (GETPROMPTWINDOW Win NIL NIL T))
then (SETQ MainWinPromptInfo (WINDOWPROP Win (QUOTE PROMPTWINDOW)))
(SETQ PromptWinPASSTOMAINCOMS (WINDOWPROP PromptWin (QUOTE
PASSTOMAINCOMS)))
(DETACHWINDOW PromptWin)) (* Stick the links legend window at upper right
corner.)
(ATTACHWINDOW (SETQ MenuWin (ADDMENU Menu NIL NC.OffScreenPosition))
Win
(QUOTE RIGHT)
(QUOTE TOP)
(QUOTE LOCALCLOSE))
(WINDOWADDPROP MenuWin (QUOTE REPAINTFN)
(QUOTE NC.LinksLegendRepaintFn))
(WINDOWADDPROP MenuWin (QUOTE RESHAPEFN)
(QUOTE NC.LinksLegendReshapeFn))
(WINDOWADDPROP MenuWin (QUOTE LINKSLEGENDWINP)
T)
(WINDOWPROP MenuWin (QUOTE MINSIZE)
(QUOTE MENUWMINSIZEFN))
(WINDOWPROP MenuWin (QUOTE MAXSIZE)
(QUOTE MENUWMINSIZEFN))
(WINDOWPROP Win (QUOTE NCLABELPAIRS)
LabelPairs) (* Put back the prompt window if it exists.)
(if PromptWin
then (ATTACHWINDOW PromptWin Win (QUOTE TOP)
(QUOTE LEFT))
(WINDOWPROP PromptWin (QUOTE PASSTOMAINCOMS)
PromptWinPASSTOMAINCOMS)
(WINDOWPROP Win (QUOTE PROMPTWINDOW)
MainWinPromptInfo))
(MOVEW Win (MAKEWITHINREGION (WINDOWREGION Win)
WHOLESCREEN)) (* For some reason, the above MOVEW tends to leave the
prompt window open.)
(if (OPENWP PromptWin)
then (CLOSEW PromptWin))
(if NC.LinkDashingInBrowser
then (NC.LinksLegendRepaintFn MenuWin NIL))
NIL)))
(NCP.CreateBrowserCard
(LAMBDA (Title ParamList NoDisplayFlg Props ParentFileBoxes)
(* rht: "25-Jan-86 17:29")
(* * Creates a new browser notecard with given type, title, props, parents, starting ID and link labels.)
(NCP.MakeBrowser Title ParamList NoDisplayFlg Props ParentFileBoxes)))
(NCP.MakeBrowser
(LAMBDA (Title ParamList NoDisplayFlg Props ParentFileBoxes)
(* rht: "25-Jan-86 17:31")
(* * Creates a new browser notecard with given type, title, props, parents, starting ID and link labels.
LinkLabels can be atom or list and can contain litatoms ALL and/or ←ALL.)
(* * rht 3/18/85: changed to take all info as a param proplist rather than as separate arguments.
Only checks validity of the Linklabels param. Will create either a StructEditBrowser or a normal Browser depending
on value of StructEditFlg.)
(PROG (ValidLinkLabels LinkLabels NewParamList)
(SETQ ValidLinkLabels (for Label in (SETQ LinkLabels (LISTGET ParamList
(QUOTE
LINKTYPES)))
join (COND
((EQ Label (QUOTE ALL))
(NCP.GetLinkLabels))
((EQ Label (QUOTE ←ALL))
(NCP.GetReverseLinkLabels))
((NOT (NCP.ValidLinkLabel Label))
(NCP.ReportError Label " not a valid link label.")
NIL)
(T (LIST Label)))))
(SETQ ValidLinkLabels (INTERSECTION ValidLinkLabels ValidLinkLabels))
(RETURN (if (AND LinkLabels (NULL ValidLinkLabels))
then NIL
else (* Make a copy of the user's param list since she may
not want it to get rplaca'd.)
(SETQ NewParamList (COPY ParamList))
(LISTPUT NewParamList (QUOTE LINKTYPES)
ValidLinkLabels)
(NCP.CreateCard (QUOTE Browser)
Title NoDisplayFlg Props ParentFileBoxes
NewParamList))))))
)
(* * rht 1/27/86: Fix for bug reported by Lissa: Back links in LinkIndex cards are broken.)
(DEFINEQ
(NC.AppendLinkIndexEntry
(LAMBDA (Stream IndexCardID ID Title LinkLabels BackLinksP)
(* rht: "25-Jan-86 17:23")
(* * Build a link index entry consisting of all instances of links from or to ID with a label in LinkLabels.
Append these to the end of Stream.)
(* * rht 1/25/86: Changed call to non-existent NC.AppendLinkToText to NCP.LocalGlobalLink.)
(PROG (FromLinks ToLinks ToLinkPairs FromLinkPairs (SortArg (FUNCTION NC.LinkIndexCompareFn)))
(SETQ ToLinks (NC.FetchToLinks ID))
(SETQ FromLinks (NC.FetchFromLinks ID))
(* * Find all winning links.)
(SETQ ToLinkPairs (SORT (for Link in ToLinks bind Label
when (SETQ Label (NC.LinkLabelP Link LinkLabels))
collect (CONS Label Link))
SortArg))
(SETQ FromLinkPairs (SORT (for Link in FromLinks bind Label
when (SETQ Label (NC.ReverseLinkLabelP Link
LinkLabels))
collect (CONS Label Link))
SortArg))
(* * Print the title of ID if there were any wins.)
(COND
((OR ToLinkPairs FromLinkPairs)
(NC.AppendStringToStream Stream Title)
(COND
(BackLinksP (NC.AppendStringToStream Stream " ")
(NCP.LocalGlobalLink NC.LinkIndexBackPtrLinkLabel IndexCardID ID
(QUOTE END)
(QUOTE Icon))))
(NC.AppendStringToStream Stream (CONCAT (CHARACTER 13)))))
(* * Print the winning links from the ID card.)
(for LinkPair in ToLinkPairs bind OldLabel Label DestID
do (SETQ Label (CAR LinkPair))
(SETQ DestID (fetch (NOTECARDLINK DESTINATIONID) of (CDR LinkPair)))
(COND
((NEQ OldLabel Label)
(NC.AppendStringToStream Stream (CONCAT " <" Label "> TO" (CHARACTER
13)))
(SETQ OldLabel Label)))
(NC.AppendStringToStream Stream " ")
(NC.AppendStringToStream Stream (NC.FetchTitle DestID))
(COND
(BackLinksP (NC.AppendStringToStream Stream " ")
(NCP.LocalGlobalLink NC.LinkIndexBackPtrLinkLabel IndexCardID
DestID (QUOTE END)
(QUOTE Icon))))
(NC.AppendStringToStream Stream (CONCAT (CHARACTER 13))))
(for LinkPair in FromLinkPairs bind OldLabel Label DestID
do (SETQ Label (CAR LinkPair))
(SETQ DestID (fetch (NOTECARDLINK SOURCEID) of (CDR LinkPair)))
(COND
((NEQ OldLabel Label)
(NC.AppendStringToStream Stream (CONCAT " <" Label "> FROM"
(CHARACTER 13)))
(SETQ OldLabel Label)))
(NC.AppendStringToStream Stream " ")
(NC.AppendStringToStream Stream (NC.FetchTitle DestID))
(COND
(BackLinksP (NC.AppendStringToStream Stream " ")
(NCP.LocalGlobalLink NC.LinkIndexBackPtrLinkLabel IndexCardID
DestID (QUOTE END)
(QUOTE Icon))))
(NC.AppendStringToStream Stream (CONCAT (CHARACTER 13)))))))
)
(* * rht 1/31/86: Fix for bug reported by Cathy where NCP.ChangeLoc ignores numeric Loc
argument.)
(DEFINEQ
(NCP.ChangeLoc
(LAMBDA (ID Loc) (* rht: "31-Jan-86 00:48")
(* * Changes the location within ID's textstream to the new loc Loc. Loc can be the litatoms START or END, a
number, or nil. The latter indicates to use the current cursor position. Note that we don't mark card as dirty just
because its selection changed. Note that this leaves card active even if inactive when we were called.)
(* * rht 1/31/86: Now works on case when Loc is numeric.)
(if (AND (NCP.ValidID ID)
(EQ (NCP.CardTypeSubstance (NCP.CardType ID))
(QUOTE TEXT)))
then (if (NOT (NCP.ActiveCardP ID))
then (NCP.ActivateCards ID))
(LET ((Stream (NC.FetchSubstance ID)))
(COND
((FMEMB Loc (QUOTE (START 0)))
(TEDIT.SETSEL Stream 0 0 (QUOTE RIGHT)))
((EQ Loc (QUOTE END))
(TEDIT.SETSEL Stream (ADD1 (fetch (TEXTOBJ TEXTLEN)
of (TEXTOBJ Stream)))
0
(QUOTE RIGHT)))
((AND (FIXP Loc)
(GREATERP Loc 0))
(TEDIT.SETSEL Stream (ADD1 Loc)
0
(QUOTE RIGHT))))
ID)
else (NCP.ReportError ID " not an existing card or non-TEXT substance type.")
NIL)))
)
(* * rht 3/28/86: Code to do browser overviews.)
(FILESLOAD (FROM VALUEOF NOTECARDSDIRECTORIES)
BROWSEROVERVIEWPATCH)
(* * kirk 29Mar86 Dave Newman's patch for the sketch link duplicates bug)
(DEFINEQ
(NC.LinkIconWhenMovedFn
(LAMBDA (ImageObject ToWindowStream FromTextStream ToTextStream)
(* Newman "20-Mar-86 13:23")
(* * Called when moving a link icon from FromTextStream to ToWindowStream. Sets the necessary link information up
for card corresponding to ToWindowStream.)
(* * rht 11/18/84: Major hacking. Now checks for all sorts of illegal cases. Either goes ahead with move, converts
link type to "Unspecified", or deletes the new "invisible" link. The code is very similar to
NC.LinkIconWhenCopiedFn except that within-filebox moves are allowed. Also when aborting a move, we must insert a
copy of the link back to take the place of the deleted original. This will all change when imageobj fns can return
DON'T.)
(* * rht 12/12/84: Now just RETFROM's rather than doing the addprocess stuff. Should be cleaner, but still ugly.)
(* * Newman "20-Mar-86 13:17" With CCM fixed multiple link in sketch card.)
(PROG (Label (Link (NC.FetchLinkFromLinkIcon ImageObject))
SourceID DestID NewSourceID NewLabel NewDisplayMode OldDisplayMode
(Window (AND ToWindowStream (WFROMDS ToWindowStream T)))
InsertPos)
(SETQ Label (fetch (NOTECARDLINK LINKLABEL) of Link))
(SETQ NewSourceID (COND
((WINDOWP Window)
(NC.IDFromWindow Window))
((TEXTSTREAMP ToTextStream)
(NC.CoerceToID ToTextStream))))
(SETQ SourceID (fetch (NOTECARDLINK SOURCEID) of Link))
(SETQ DestID (fetch (NOTECARDLINK DESTINATIONID) of Link))
(SETQ OldDisplayMode (fetch (NOTECARDLINK DISPLAYMODE) of Link))
(COND
((AND (NULL FromTextStream)
(NULL ToTextStream)) (* We must be moving within a sketch.)
(SETQ NewSourceID SourceID))
((TEXTSTREAMP ToTextStream) (* If it's a text copy, then compute position to
insert link at.)
(SETQ InsertPos (NC.CharPosFromTextObject (TEXTOBJ ToTextStream)))))
(COND
((NULL NewSourceID) (* Trying to copy to a non NoteCard stream)
(NC.PrintMsg Window NIL (CONCAT "Tried to move a NoteCards link icon"
" to a non-NoteCards stream!!."
(CHARACTER 13)
"Tsk. Tsk."
(CHARACTER 13)))
(RETFROM (QUOTE TEDIT.MOVE)
NIL T))
((NULL (NC.LinksSupportedP NewSourceID (QUOTE (Local))))
(NC.PrintMsg Window NIL (CONCAT "Tried to move a NoteCards link icon"
" to a NoteCard that"
" does not support links!!."
(CHARACTER 13)
"Tsk. Tsk."
(CHARACTER 13)))
(RETFROM (QUOTE TEDIT.MOVE)
NIL T))
((AND (FMEMB Label (QUOTE (FiledCard SubBox)))
(NEQ (NC.FetchType NewSourceID)
(QUOTE FileBox))) (* Move from filebox to non-filebox.)
(NC.PrintMsg NIL NIL (CONCAT
"Tried to move filedcard or subbox link to a non-filebox."
(CHARACTER 13)
"Link type of copy set to 'Unspecified'."
(CHARACTER 13)))
(SETQ NewLabel NC.UnspecifiedLinkLabel)
(SETQ NewDisplayMode (create LINKDISPLAYMODE
copying OldDisplayMode SHOWTITLEFLG ← T SHOWLINKTYPEFLG
← T)))
((AND (NEQ (NC.FetchType SourceID)
(QUOTE FileBox))
(EQ (NC.FetchType NewSourceID)
(QUOTE FileBox))) (* Move from non-filebox to filebox.)
(NC.PrintMsg NIL NIL (CONCAT "Can't move links from non-filebox to filebox."
(CHARACTER 13)
"Try using PutCardsHere."
(CHARACTER 13)))
(RETFROM (QUOTE TEDIT.MOVE)
NIL T))
((AND (EQ (NC.FetchType NewSourceID)
(QUOTE FileBox))
(NEQ NewSourceID SourceID)
(for Link1 in (NC.FetchToLinks NewSourceID)
thereis (AND (NC.ChildLinkP Link1)
(EQ DestID (fetch (NOTECARDLINK DESTINATIONID)
of Link1)))))
(* Move to a filebox already containing this child.)
(NC.PrintMsg NIL NIL (CONCAT (NC.RetrieveTitle DestID PSA.Database)
" not moved: already appears as a child of "
(NC.RetrieveTitle NewSourceID PSA.Database)
(CHARACTER 13)))
(RETFROM (QUOTE TEDIT.MOVE)
NIL T))
((AND (EQ Label (QUOTE SubBox))
(NEQ NewSourceID SourceID)
(OR (EQ NewSourceID DestID)
(NOT (NC.NotDaughterP DestID NewSourceID (FUNCTION NC.ChildLinkP))))
) (* Move to a filebox causes a cycle.)
(NC.PrintMsg NIL NIL (CONCAT "Couldn't move " Link " because of subbox cycle."
(CHARACTER 13)))
(RETFROM (QUOTE TEDIT.MOVE)
NIL T))
((AND (FMEMB Label NC.SystemLinkLabels)
(NOT (FMEMB Label (QUOTE (FiledCard SubBox))))
(NEQ NewSourceID SourceID)) (* Move of system link outside of own card.)
(NC.PrintMsg NIL NIL (CONCAT "Tried to copy system link." (CHARACTER 13)
"Link type of copy set to 'Unspecified'."
(CHARACTER 13)))
(SETQ NewLabel NC.UnspecifiedLinkLabel)
(SETQ NewDisplayMode (create LINKDISPLAYMODE
copying OldDisplayMode SHOWTITLEFLG ← T SHOWLINKTYPEFLG
← T))))
(IMAGEOBJPROP ImageObject (QUOTE LinkBeingMoved)
Link)
(* * Here one must check to see if the source card of the link being moved is a Sketch If so, we do nothing.
This corrects the bug where extra links were created as a result of moving a link within a sketch or copying a link
within a sketch. Dave Newman and Cathy Marshall fixed this here bug.)
(COND
((NOT (EQUAL (QUOTE Sketch)
(NCP.CardType SourceID)))
(NC.FillInLinkIcon ImageObject (OR NewLabel Label)
DestID NewSourceID (OR NewDisplayMode OldDisplayMode)
(NC.LinkAtCharPos InsertPos ToTextStream)))))))
)
(PUTPROPS POSTRELEASEPATCHES COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1302 5811 (NC.OpenDatabaseFile 1312 . 5809)) (5933 17860 (NC.MakeBrowserCard 5943 .
12512) (NC.MakeLinksLegendMenu 12514 . 15700) (NCP.CreateBrowserCard 15702 . 16085) (NCP.MakeBrowser
16087 . 17858)) (17959 21267 (NC.AppendLinkIndexEntry 17969 . 21265)) (21374 22755 (NCP.ChangeLoc
21384 . 22753)) (22964 29431 (NC.LinkIconWhenMovedFn 22974 . 29429)))))
STOP