(FILECREATED "20-Mar-86 13:25:39" {DSK}<LISPFILES>NEW>DVN-CCMPATCH001.;1 6820
changes to: (VARS DVN-CCMPATCH001COMS))
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DVN-CCMPATCH001COMS)
(RPAQQ DVN-CCMPATCH001COMS ((FNS NC.LinkIconWhenMovedFn)))
(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 DVN-CCMPATCH001 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (305 6734 (NC.LinkIconWhenMovedFn 315 . 6732)))))
STOP