(FILECREATED " 8-Feb-85 21:58:42" {PHYLUM}<NOTECARDS>RELEASE1.2>FGHPATCH002.;2 19798
changes to: (VARS FGHPATCH002COMS)
(FNS NC.LinksSupportedP NC.LinkIconWhenCopiedFn NC.LinkIconWhenMovedFn
NC.LinkAnchorModesFromType NC.MakeSubstanceTypesList)
previous date: " 8-Feb-85 19:02:45" {PHYLUM}<NOTECARDS>RELEASE1.2>FGHPATCH002.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FGHPATCH002COMS)
(RPAQQ FGHPATCH002COMS ((* * Newly defined FNS intended for NCTYPESMECH)
(FNS NC.LinksSupportedP NC.LinkAnchorModesFromType)
(* * Redefined FNS and RECORDS from NCTYPESMECH)
(FNS NC.AddSubstanceType NC.AddCardType NC.MakeSubstanceTypesList)
(RECORDS NoteCardType SubstanceType)
(* * REdefined FNS from NCLINKS)
(FNS NC.LinkIconWhenCopiedFn NC.LinkIconWhenMovedFn)))
(* * Newly defined FNS intended for NCTYPESMECH)
(DEFINEQ
(NC.LinksSupportedP
(LAMBDA (ID AnchorModesList) (* fgh: " 8-Feb-85 21:00")
(* * Are all of the anchor modes supporterd by the card ID)
(PROG ((SupportedAnchorModes (NC.LinkAnchorModesFromType (NC.FetchType ID))))
(COND
((EQ SupportedAnchorModes T)
(RETURN T))
((NULL SupportedAnchorModes)
(RETURN NIL))
(T (RETURN (for AnchorMode in AnchorModesList always (FMEMB AnchorMode
SupportedAnchorModes))))))))
(NC.LinkAnchorModesFromType
(LAMBDA (NoteCardType) (* fgh: " 8-Feb-85 18:59")
(* * Return a list of the link anchor modes supported by cards of type NoteCardType)
(PROG ((Result (NC.Inherit NC.LinkAnchorModesFromType CardLinkAnchorModesSupported
SubstanceLinkAnchorModesSupported NoteCardType)))
(COND
((EQ Result T)
(RETURN T))
(T (RETURN (MKLIST Result)))))))
)
(* * Redefined FNS and RECORDS from NCTYPESMECH)
(DEFINEQ
(NC.AddSubstanceType
(LAMBDA (SubstanceName CreateSubstanceFn EditSubstanceFn QuitSubstanceFn GetSubstanceFn
PutSubstanceFn CopySubstanceFn MarkSubstanceDirtyFn SubstanceDirtyPFn
CollectLinksInSubstanceFn DeleteLinksInSubstanceFn
UpdateLinkIconsInSubstanceFn DefaultWidth DefaultHeight
LinkAnchorModesSupported) (* fgh: " 8-Feb-85 18:52")
(* * Add a substance ttype to the lists of substance types.)
(PROG (NewType)
(COND
((NULL SubstanceName)
(NC.ReportError "NC.AddSubstanceType" "Illegal substance type name: NIL")))
(* * Remove old instance of SubstanceType)
(for SubstanceType in NC.SubstanceTypes when (EQ (fetch (SubstanceType SubstanceName)
of SubstanceType)
SubstanceName)
do (SETQ NC.SubstanceTypes (REMOVE SubstanceType NC.SubstanceTypes)))
(* * Add new SubstanceType to NC.SubstanceTypes list)
(SETQ NC.SubstanceTypes
(CONS (SETQ NewType
(create SubstanceType
SubstanceName ← SubstanceName
CreateSubstanceFn ← CreateSubstanceFn
EditSubstanceFn ← EditSubstanceFn
QuitSubstanceFn ← QuitSubstanceFn
GetSubstanceFn ← GetSubstanceFn
PutSubstanceFn ← PutSubstanceFn
CopySubstanceFn ← CopySubstanceFn
MarkSubstanceDirtyFn ← MarkSubstanceDirtyFn
SubstanceDirtyPFn ← SubstanceDirtyPFn
CollectLinksInSubstanceFn ← CollectLinksInSubstanceFn
DeleteLinksInSubstanceFn ← DeleteLinksInSubstanceFn
UpdateLinkIconsInSubstanceFn ← UpdateLinkIconsInSubstanceFn
SubstanceDefaultWidth ← DefaultWidth
SubstanceDefaultHeight ← DefaultHeight
SubstanceLinkAnchorModesSupported ← LinkAnchorModesSupported))
NC.SubstanceTypes))
(RETURN NewType))))
(NC.AddCardType
(LAMBDA (TypeName SuperType SubstanceType MakeCardFn EditCardFn QuitCardFn GetCardFn PutCardFn
CopyCardFn MarkCardDirtyFn CardDirtyPFn CollectLinksInCardFn DeleteLinksInCardFn
UpdateLinkIconsInCardFn LinkDisplayMode DefaultWidth DefaultHeight
LinkAnchorModesSupported) (* fgh: " 8-Feb-85 18:54")
(* * Create a new note acrd type and link it into the card type heirarchy.)
(PROG (NewType)
(COND
((NULL TypeName)
(NC.ReportError "NC.AddCardType" "Illegal type name: NIL"))
((for Type in NC.CardTypes never (EQ (fetch (NoteCardType TypeName) of Type)
SuperType))
(NC.ReportError "NC.AddCardType" (CONCAT "Unknown type in super type field: "
SuperType)))
((for Substance in NC.SubstanceTypes never (EQ SubstanceType (fetch (SubstanceType
SubstanceName)
of Substance)))
(NC.ReportError "NC.AddCardType" (CONCAT "Unknown substance type field: "
SubstanceType))))
(* * Remove old instance of this NoteCardType)
(for CardType in NC.CardTypes when (EQ (fetch (NoteCardType TypeName) of CardType)
TypeName)
do (SETQ NC.CardTypes (REMOVE CardType NC.CardTypes)))
(* * Create new NoteCardType)
(SETQ NC.CardTypes
(NCONC1 NC.CardTypes
(SETQ NewType
(create NoteCardType
TypeName ← TypeName
SuperType ← SuperType
SubstanceType ← SubstanceType
MakeCardFn ← MakeCardFn
EditCardFn ← EditCardFn
QuitCardFn ← QuitCardFn
GetCardFn ← GetCardFn
PutCardFn ← PutCardFn
CopyCardFn ← CopyCardFn
MarkCardDirtyFn ← MarkCardDirtyFn
CardDirtyPFn ← CardDirtyPFn
CollectLinksInCardFn ← CollectLinksInCardFn
DeleteLinksInCardFn ← DeleteLinksInCardFn
UpdateLinkIconsInCardFn ← UpdateLinkIconsInCardFn
LinkDisplayMode ← LinkDisplayMode
CardDefaultHeight ← DefaultHeight
CardDefaultWidth ← DefaultWidth
CardLinkAnchorModesSupported ← LinkAnchorModesSupported))))
(SETQ NC.NoteCardTypeMenu)
(RETURN NewType))))
(NC.MakeSubstanceTypesList
(LAMBDA NIL (* fgh: " 8-Feb-85 18:59")
(* * Make the initial list of substance types.)
(SETQ NC.SubstanceTypes NIL)
(NC.AddSubstanceType (QUOTE TEXT)
(FUNCTION OPENTEXTSTREAM)
(FUNCTION NC.BringUpTEditCard)
(FUNCTION NC.TEditCloseFn)
(FUNCTION NC.GetTextSubstance)
(FUNCTION NC.PutTextSubstance)
(FUNCTION NC.TextCopySubstance)
(FUNCTION NC.MarkTextDirty)
(FUNCTION NC.TextDirtyP)
(FUNCTION NC.CollectReferencesInText)
(FUNCTION NC.DelReferencesToCardFromText)
(FUNCTION NC.UpdateLinkImagesInText)
300 200 T)
(NC.AddSubstanceType (QUOTE GRAPH)
(FUNCTION (LAMBDA NIL
(create GRAPH)))
(FUNCTION NC.BringUpGraphCard)
(FUNCTION NC.GraphCardCloseFn)
(FUNCTION NC.GetGraphSubstance)
(FUNCTION NC.PutGraphSubstance)
(FUNCTION NC.GraphCopySubstance)
(FUNCTION NC.MarkGraphDirty)
(FUNCTION NC.GraphDirtyP)
(FUNCTION NC.CollectReferencesInGraph)
(FUNCTION NC.DelReferencesToCardFromGraph)
(FUNCTION NC.UpdateLinkImagesInGraph)
300 200 T)
(NC.AddSubstanceType (QUOTE SKETCH)
(FUNCTION (LAMBDA NIL
(create SKETCH)))
(FUNCTION NC.BringUpSketchCard)
(FUNCTION NC.SketchCardCloseFn)
(FUNCTION (LAMBDA (Stream ID Region)
(PROG ((Value (NC.GetSketchSubstance Stream)))
(NC.SetScale ID (CADR Value))
(NC.SetRegionViewed ID (CADDR Value))
(RETURN (CAR Value)))))
(FUNCTION NC.PutSketchSubstance)
(FUNCTION NC.SketchCopySubstance)
(FUNCTION NC.MarkSketchDirty)
(FUNCTION NC.SketchDirtyP)
(FUNCTION NC.CollectReferencesInSketch)
(FUNCTION NC.DelReferencesToCardFromSketch)
(FUNCTION NC.UpdateLinkImagesInSketch)
400 350 T)
(QUOTE Done)))
)
[DECLARE: EVAL@COMPILE
(RECORD NoteCardType (TypeName SuperType SubstanceType MakeCardFn EditCardFn QuitCardFn GetCardFn
PutCardFn CopyCardFn MarkCardDirtyFn CardDirtyPFn CollectLinksInCardFn
DeleteLinksInCardFn UpdateLinkIconsInCardFn LinkDisplayMode
CardDefaultWidth CardDefaultHeight CardLinkAnchorModesSupported))
(RECORD SubstanceType (SubstanceName CreateSubstanceFn EditSubstanceFn QuitSubstanceFn GetSubstanceFn
PutSubstanceFn CopySubstanceFn MarkSubstanceDirtyFn
SubstanceDirtyPFn CollectLinksInSubstanceFn
DeleteLinksInSubstanceFn UpdateLinkIconsInSubstanceFn
SubstanceDefaultWidth SubstanceDefaultHeight
SubstanceLinkAnchorModesSupported))
]
(* * REdefined FNS from NCLINKS)
(DEFINEQ
(NC.LinkIconWhenCopiedFn
(LAMBDA (ImageObject ToWindowStream FromTextStream ToTextStream)
(* fgh: " 8-Feb-85 20:58")
(* * 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.)
(PROG (Label (Link (NC.FetchLinkFromLinkIcon ImageObject))
SourceID DestID NewSourceID NewLabel NewDisplayMode ImageObjectCopy
(Window (AND ToWindowStream (WFROMDS ToWindowStream T))))
(SETQ Label (fetch (NOTECARDLINK LINKLABEL) of Link))
(SETQ NewSourceID (NC.CoerceToID ToTextStream))
(SETQ SourceID (fetch (NOTECARDLINK SOURCEID) of Link))
(SETQ DestID (fetch (NOTECARDLINK DESTINATIONID) of Link))
(SETQ ImageObjectCopy (IMAGEOBJPROP ImageObject (QUOTE ImageObjectCopy)))
(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)))
(RETFROM (QUOTE TEDIT.COPY)
NIL T))
((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)))
(RETFROM (QUOTE TEDIT.COPY)
NIL 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 (QUOTE Both)))
((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)))
(RETFROM (QUOTE TEDIT.COPY)
NIL 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)))
(RETFROM (QUOTE TEDIT.COPY)
NIL 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)))
(RETFROM (QUOTE TEDIT.COPY)
NIL 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)))
(RETFROM (QUOTE TEDIT.COPY)
NIL 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 (QUOTE Both))))
(NC.FillInLinkIcon ImageObjectCopy (OR NewLabel Label)
DestID NewSourceID (OR NewDisplayMode (fetch (NOTECARDLINK DISPLAYMODE)
of Link))))))
(NC.LinkIconWhenMovedFn
(LAMBDA (ImageObject ToWindowStream FromTextStream ToTextStream)
(* fgh: " 8-Feb-85 20:58")
(* * 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.)
(PROG (Label (Link (NC.FetchLinkFromLinkIcon ImageObject))
SourceID DestID NewSourceID NewLabel NewDisplayMode (Window (AND ToWindowStream
(WFROMDS
ToWindowStream T)))
)
(SETQ Label (fetch (NOTECARDLINK LINKLABEL) of Link))
(SETQ NewSourceID (NC.CoerceToID ToTextStream))
(SETQ SourceID (fetch (NOTECARDLINK SOURCEID) of Link))
(SETQ DestID (fetch (NOTECARDLINK DESTINATIONID) of Link))
(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 (QUOTE Both)))
((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 CollectChildren."
(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 (QUOTE Both))))
(IMAGEOBJPROP ImageObject (QUOTE LinkBeingMoved)
Link)
(NC.FillInLinkIcon ImageObject (OR NewLabel Label)
DestID NewSourceID (OR NewDisplayMode (fetch (NOTECARDLINK DISPLAYMODE)
of Link))))))
)
(PUTPROPS FGHPATCH002 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (905 1974 (NC.LinksSupportedP 915 . 1480) (NC.LinkAnchorModesFromType 1482 . 1972)) (
2030 8372 (NC.AddSubstanceType 2040 . 3940) (NC.AddCardType 3942 . 6317) (NC.MakeSubstanceTypesList
6319 . 8370)) (9159 19716 (NC.LinkIconWhenCopiedFn 9169 . 14483) (NC.LinkIconWhenMovedFn 14485 . 19714
)))))
STOP