(FILECREATED "12-Jul-85 17:50:33" {PHYLUM}<NOTECARDS>RELEASE1.2I>FGHPATCH018.;2 8715
changes to: (VARS FGHPATCH018COMS)
(FNS NC.LinkIconWhenCopiedFn NC.PushCopyLinkIcon)
previous date: "12-Jul-85 12:43:09" {PHYLUM}<NOTECARDS>RELEASE1.2I>FGHPATCH018.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FGHPATCH018COMS)
(RPAQQ FGHPATCH018COMS ((* * Redefined from NCLINKS -- fixes to PushCopyLinks stuff)
(FNS NC.LinkIconWhenCopiedFn NC.PushCopyLinkIcon)))
(* * Redefined from NCLINKS -- fixes to PushCopyLinks stuff)
(DEFINEQ
(NC.LinkIconWhenCopiedFn
(LAMBDA (ImageObject ToWindowStream FromTextStream ToTextStream)
(* fgh: "12-Jul-85 12:40")
(* * Called when copying 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 copy, converts
link type to "Unspecified", or deletes the new "invisible" link. The latter will change when imageobj fns can return
DON'T.)
(* * rht 12/12/84: now does RETFROM instead of adding processes to delete imageobj's. This is cleaner, but still
ugly.)
(* * rht 3/25/85: Fixed to handle copies within a sketch card. That is indicated by nullity of the two textstream
args.)
(PROG (Label (Link (NC.FetchLinkFromLinkIcon ImageObject))
SourceID DestID NewSourceID NewLabel NewDisplayMode OldDisplayMode
(ImageObjectCopy (IMAGEOBJPROP ImageObject (QUOTE ImageObjectCopy)))
(Window (AND ToWindowStream (WFROMDS ToWindowStream T)))
(InTEditCopyFlg (COND
((STKPOS (QUOTE TEDIT.COPY))
T)))
InsertPos)
(SETQ Label (fetch (NOTECARDLINK LINKLABEL) of Link))
(SETQ SourceID (fetch (NOTECARDLINK SOURCEID) of Link))
(SETQ DestID (fetch (NOTECARDLINK DESTINATIONID) of Link))
(SETQ OldDisplayMode (fetch (NOTECARDLINK DISPLAYMODE) of Link))
(SETQ NewSourceID (COND
((WINDOWP Window)
(NC.IDFromWindow Window))
((TEXTSTREAMP ToTextStream)
(NC.CoerceToID ToTextStream)))) (* If it's a text copy, then compute position to insert
link at.)
(AND (TEXTSTREAMP ToTextStream)
(SETQ InsertPos (NC.CharPosFromTextObject (TEXTOBJ ToTextStream))))
(COND
((NULL NewSourceID) (* Trying to copy to a non NoteCard stream)
(NC.PrintMsg Window NIL (CONCAT "Tried to copy a NoteCards link icon"
" to a non-NoteCards stream!!."
(CHARACTER 13)
"Tsk. Tsk."
(CHARACTER 13)))
(NC.CoerceToExternalPutLinkIcon ImageObjectCopy SourceID DestID Label)
(RETURN NIL))
((NULL (NC.LinksSupportedP NewSourceID (QUOTE (Local))))
(NC.PrintMsg Window NIL (CONCAT "Tried to copy a NoteCards link icon"
" to a NoteCard that"
" does not support links!!."
(CHARACTER 13)
"Tsk. Tsk."
(CHARACTER 13)))
(COND
(InTEditCopyFlg (RETFROM (QUOTE TEDIT.COPY)
NIL T))
(T (RETURN (QUOTE DON'T)))))
((AND (FMEMB Label (QUOTE (FiledCard SubBox)))
(NEQ (NC.FetchType NewSourceID)
(QUOTE FileBox))) (* Copy from filebox to non-filebox.)
(NC.PrintMsg NIL NIL (CONCAT "Tried to copy 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))) (* Copy from non-filebox to filebox.)
(NC.PrintMsg NIL NIL (CONCAT "Can't copy links from non-filebox to filebox."
(CHARACTER 13)
"Try using CollectChildren."
(CHARACTER 13)))
(COND
(InTEditCopyFlg (RETFROM (QUOTE TEDIT.COPY)
NIL T))
(T (RETURN (QUOTE DON'T)))))
((AND (FMEMB Label (QUOTE (FiledCard SubBox)))
(EQ NewSourceID SourceID)) (* Copy within same filebox.)
(NC.PrintMsg NIL NIL (CONCAT "Can't copy links within a FileBox. Try move instead."
(CHARACTER 13)))
(COND
(InTEditCopyFlg (RETFROM (QUOTE TEDIT.COPY)
NIL T))
(T (RETURN (QUOTE DON'T)))))
((AND (EQ (NC.FetchType NewSourceID)
(QUOTE FileBox))
(for Link1 in (NC.FetchToLinks NewSourceID)
thereis (AND (NC.ChildLinkP Link1)
(EQ DestID (fetch (NOTECARDLINK DESTINATIONID) of Link1)))))
(* Copy to a filebox already containing this child.)
(NC.PrintMsg NIL NIL (CONCAT (NC.RetrieveTitle DestID PSA.Database)
" not copied: already appears as a child of "
(NC.RetrieveTitle NewSourceID PSA.Database)
(CHARACTER 13)))
(COND
(InTEditCopyFlg (RETFROM (QUOTE TEDIT.COPY)
NIL T))
(T (RETURN (QUOTE DON'T)))))
((AND (EQ Label (QUOTE SubBox))
(OR (EQ NewSourceID DestID)
(NOT (NC.NotDaughterP DestID NewSourceID (FUNCTION NC.ChildLinkP)))))
(* Copy to a filebox causes a cycle.)
(NC.PrintMsg NIL NIL (CONCAT "Couldn't copy " Link " because of subbox cycle."
(CHARACTER 13)))
(COND
(InTEditCopyFlg (RETFROM (QUOTE TEDIT.COPY)
NIL T))
(T (RETURN (QUOTE DON'T)))))
((AND (FMEMB Label NC.SystemLinkLabels)
(NOT (FMEMB Label (QUOTE (FiledCard SubBox))))
(NEQ NewSourceID SourceID)) (* Copy 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))))
(NC.FillInLinkIcon ImageObjectCopy (OR NewLabel Label)
DestID NewSourceID (OR NewDisplayMode OldDisplayMode)
(NC.LinkAtCharPos InsertPos ToTextStream)))))
(NC.PushCopyLinkIcon
(LAMBDA (LinkIcon Window) (* fgh: "12-Jul-85 12:41")
(* * Do a push-copy of LinkIcon from Window)
(PROG (ID NoteCardType InsertLinkFn TranslatePositionFn NewLinkIcon ScreenPosition NewWindow
WindowPositionX WindowPositionY InsertPos)
(SETQ ScreenPosition (GETPOSITION))
(SETQ NewWindow (WHICHW ScreenPosition))
(SETQ WindowPositionX (LASTMOUSEX NewWindow))
(SETQ WindowPositionY (LASTMOUSEY NewWindow))
(COND
((AND (WINDOWP NewWindow)
(SETQ ID (NC.IDFromWindow NewWindow))
(SETQ NoteCardType (NC.FetchType ID))
(SETQ InsertLinkFn (NC.InsertLinkFn NoteCardType))
(SETQ TranslatePositionFn (NC.TranslateWindowPositionFn NoteCardType)))
(SETQ InsertPos (APPLY* TranslatePositionFn NewWindow WindowPositionX WindowPositionY))
(SETQ NewLinkIcon (APPLY* (IMAGEOBJPROP LinkIcon (QUOTE COPYFN))
LinkIcon))
(AND (NEQ (APPLY* (IMAGEOBJPROP LinkIcon (QUOTE WHENCOPIEDFN))
LinkIcon
(WINDOWPROP NewWindow (QUOTE DSP))
(WINDOWPROP Window (QUOTE TEXTSTREAM))
(WINDOWPROP NewWindow (QUOTE TEXTSTREAM)))
(QUOTE DON'T))
(APPLY* InsertLinkFn NewWindow (NC.FetchLinkFromLinkIcon NewLinkIcon)
InsertPos))))
(RETURN NIL))))
)
(PUTPROPS FGHPATCH018 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (596 8633 (NC.LinkIconWhenCopiedFn 606 . 7134) (NC.PushCopyLinkIcon 7136 . 8631)))))
STOP