(FILECREATED "22-May-85 16:37:30" {PHYLUM}<NOTECARDS>RELEASE1.2>NCSKETCHSUBSTANCE.;4 11411
changes to: (FNS NC.SketchCardCloseFn)
previous date: "22-May-85 01:12:49" {PHYLUM}<NOTECARDS>RELEASE1.2>NCSKETCHSUBSTANCE.;3)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCSKETCHSUBSTANCECOMS)
(RPAQQ NCSKETCHSUBSTANCECOMS ((E (SETQ NC.SystemDate (DATE))
(UNMARKASCHANGED (QUOTE NC.SystemDate)
(QUOTE VARS)))
(VARS NC.SystemDate)
(P (UNMARKASCHANGED (QUOTE NC.SystemDate)
(QUOTE VARS)))
(FILES NCTYPESMECH)
(GLOBALVARS NC.SketchTitleBarMenu)
(FNS NC.BringUpSketchCard NC.SketchDirtyP NC.SketchCardCloseFn
NC.SketchCopySubstance NC.MarkSketchDirty
NC.CollectReferencesInSketch NC.SketchBasedP)
(DECLARE: DONTCOPY (FILES (FROM VALUEOF LISPUSERSDIRECTORIES LOADCOMP)
SKETCH SKETCHOBJ)
(FILES (FROM {PHYLUM}<NOTECARDS>MAPS> LOADCOMP)
NEWMAP))
(ADVISE CREATE.SKETCHW.COMMANDMENU)
(* * This stuff supports the "push-copy" method of copying links in NC)
(FNS NC.TranslateWindowPositionToSketchPosition)
(* * Add sketch substance type to SubstanceTypes list)
(FNS NC.AddSketchSubstance)
(P (NC.AddSketchSubstance))))
(RPAQQ NC.SystemDate "22-May-85 16:37:32")
(UNMARKASCHANGED (QUOTE NC.SystemDate)
(QUOTE VARS))
(FILESLOAD NCTYPESMECH)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.SketchTitleBarMenu)
)
(DEFINEQ
(NC.BringUpSketchCard
(LAMBDA (ID Substance Region/Position) (* fgh: " 5-Feb-85 19:15")
(* Bring up a sketch card containing substance in
specified region)
(* * rht 2/1/85: Added windowprop to prevent sketch asking about saving changes.)
(PROG (Region Title SketchViewer)
(COND
((SETQ SketchViewer (NC.FetchWindow ID))
(RPTQ 2 (FLASHW SketchViewer))
(TOTOPW SketchViewer)
(TTY.PROCESS (WINDOWPROP SketchViewer (QUOTE PROCESS)))
(RETURN SketchViewer)))
(SETQ SketchViewer (SKETCHW.CREATE (OR Substance ID)
(NC.FetchRegionViewed ID)
(NC.DetermineDisplayRegion ID Region/Position)
(NC.FetchTitle ID)
(NC.FetchScale ID)))
(WINDOWPROP SketchViewer (QUOTE DONTQUERYCHANGES)
T)
(NC.SetupTitleBarMenu SketchViewer ID (QUOTE Sketch))
(RETURN SketchViewer))))
(NC.SketchDirtyP
(LAMBDA (ID) (* rht: " 1-Feb-85 15:47")
(* * rht 2/1/85: No longer checks FILEPKGCHANGES. Now uses window prop. Note that we really should have a flag on
the sketch object itself.)
(OR (WINDOWPROP (NC.FetchWindow ID)
(QUOTE SKETCHCHANGED))
(NULL (NC.FetchScale ID))
(NULL (NC.FetchRegionViewed ID)))))
(NC.SketchCardCloseFn
(LAMBDA (WindowOrID) (* rht: "22-May-85 15:40")
(* Quit from a sketch card, saving information on the
database)
(* * rht 12/20/84: Added ugly kludge, setting SKETCHCHANGED to nil, to keep sketch from asking whether to save
changes or not.)
(* * rht 2/1/85: Removed above mentioned ugly kludge. It's now taken care of by a windowprop.
Now closes all sketch viewers for this sketch.)
(PROG (ID Window OldRegion NewRegion)
(SETQ ID (NC.CoerceToID WindowOrID))
(SETQ Window (NC.FetchWindow ID))
(COND
(Window (for Viewer in (ALL.SKETCH.VIEWERS (NC.FetchSubstance ID)) do (SKETCHW.CLOSEFN
Viewer))
(SKED.CLEAR.SELECTION Window)
(for AttachedWindow in (ATTACHEDWINDOWS Window)
do (DETACHWINDOW AttachedWindow)
(CLOSEW AttachedWindow))))
(COND
(Window (REMOVEPROMPTWINDOW Window)
(WINDOWPROP Window (QUOTE SKETCHOPMENU)
NIL)))
(TTY.PROCESS T)
(NC.DeactivateCard ID))))
(NC.SketchCopySubstance
(LAMBDA (ID FromStream ToStream) (* fgh: "23-Oct-84 11:43")
(* * Copy a sketch substance from FromStream to ToStream.)
(PROG (FromStartPtr FromEndPtr ToEndPtrLoc ToEndPtr ToStartPtr)
(* * Set up start/end pointers on ToStream)
(SETQ ToStartPtr (IPLUS (GETFILEPTR ToStream)
6))
(NC.PutPtr ToStream ToStartPtr)
(SETQ ToEndPtrLoc (GETFILEPTR ToStream))
(NC.PutPtr ToStream 0)
(* * Get FromStream start/end pointers)
(SETQ FromStartPtr (NC.GetPtr FromStream 3))
(SETQ FromEndPtr (NC.GetPtr FromStream 3))
(* * Copy the bytes)
(COPYBYTES FromStream ToStream FromStartPtr FromEndPtr)
(* * Set up the ned ptr on the ToStream)
(SETQ ToEndPtr (GETFILEPTR ToStream))
(SETFILEPTR ToStream ToEndPtrLoc)
(NC.PutPtr ToStream ToEndPtr)
(RETURN T))))
(NC.MarkSketchDirty
(LAMBDA (ID ResetFlg) (* rht: " 1-Feb-85 15:37")
(* * Mark or unmark sketch as having been changed.)
(* * rht 2/1/85: Now goes through window prop rather than FILEPKG.)
(WINDOWPROP (NC.FetchWindow ID)
(QUOTE SKETCHCHANGED)
ResetFlg)))
(NC.CollectReferencesInSketch
(LAMBDA (ID CheckAndDeleteFlg DatabaseStream ReturnLinkIconsFlg ReturnLocationsFlg)
(* rht: " 6-Feb-85 14:36")
(* * Return a list of all links in sketch substance Substance. If CheckAndDeleteFlg, then delete any links found
that are not valid links.)
(PROG ((Substance (NC.FetchSubstance ID))
DirtyFlg Links LinkIcon CollectItem ActualLink)
(SETQ Links (for SketchElt in (SUBSET (fetch (SKETCH SKETCHELTS) of Substance)
(FUNCTION (LAMBDA (SketchElt)
(AND (EQ (fetch (INDIVIDUALGLOBALPART GTYPE)
of (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of SketchElt))
(QUOTE SKIMAGEOBJ))
(NC.LinkIconImageObjP
(fetch (SKIMAGEOBJ SKIMAGEOBJ)
of (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of SketchElt)))))))
when (PROG NIL
(SETQ ActualLink (NC.FetchLinkFromLinkIcon
(SETQ LinkIcon (fetch (SKIMAGEOBJ SKIMAGEOBJ)
of (fetch (GLOBALPART INDIVIDUALGLOBALPART)
of SketchElt)))))
(COND
((NULL CheckAndDeleteFlg)
(* No checking required)
(RETURN T))
((AND (LISTP CheckAndDeleteFlg)
(FMEMB (fetch (NOTECARDLINK DESTINATIONID) of ActualLink)
CheckAndDeleteFlg))
(* Already checked since ID cached on CheckAndDeleteFlg
list)
(RETURN T))
((NC.ValidLinkP ActualLink DatabaseStream)
(* Link is valid)
(RETURN T))
(T (* Link is bad. Replace it with the DeletedLink image
object.)
(replace (SKIMAGEOBJ SKIMAGEOBJ) of (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of SketchElt)
with NC.DeletedLinkImageObject)
(SETQ DirtyFlg T)
(RETURN NIL))))
collect (PROGN (SETQ CollectItem (COND
(ReturnLinkIconsFlg LinkIcon)
(T ActualLink)))
(COND
(ReturnLocationsFlg
(CONS CollectItem (LOWERLEFT (fetch (SKIMAGEOBJ
SKIMOBJ.GLOBALREGION)
of (fetch (GLOBALPART
INDIVIDUALGLOBALPART)
of SketchElt)))))
(T CollectItem)))))
(RETURN (CONS Links DirtyFlg)))))
(NC.SketchBasedP
(LAMBDA (NoteCardType) (* fgh: "20-Aug-84 01:57")
(* * Returns T if NoteCardType is a note card type that is based on Sketch or else an ID of such a note card.
NIL otherise.)
(PROG ((SketchType (QUOTE (SKETCH))))
(RETURN (OR (FMEMB NoteCardType SketchType)
(AND (NC.IDP NoteCardType)
(FMEMB (NC.FetchType NoteCardType)
SketchType)))))))
)
(DECLARE: DONTCOPY
(FILESLOAD (FROM VALUEOF LISPUSERSDIRECTORIES LOADCOMP)
SKETCH SKETCHOBJ)
(FILESLOAD (FROM {PHYLUM}<NOTECARDS>MAPS> LOADCOMP)
NEWMAP)
)
(PUTPROPS CREATE.SKETCHW.COMMANDMENU READVICE (NIL (AFTER NIL (NC.RemoveSketchMenuItems !VALUE))))
(READVISE CREATE.SKETCHW.COMMANDMENU)
(* * This stuff supports the "push-copy" method of copying links in NC)
(DEFINEQ
(NC.TranslateWindowPositionToSketchPosition
(LAMBDA (Window WindowPositionX WindowPositionY) (* fgh: "15-Feb-85 22:01")
(create POSITION
XCOORD ← WindowPositionX
YCOORD ← WindowPositionY)))
)
(* * Add sketch substance type to SubstanceTypes list)
(DEFINEQ
(NC.AddSketchSubstance
(LAMBDA NIL (* fgh: "15-Feb-85 22:58")
(NC.AddSubstanceType (QUOTE SKETCH)
(BQUOTE ((CreateSubstanceFn , (FUNCTION (LAMBDA NIL
(create SKETCH))))
(EditSubstanceFn , (FUNCTION NC.BringUpSketchCard))
(QuitSubstanceFn , (FUNCTION NC.SketchCardCloseFn))
(GetSubstanceFn , (FUNCTION (LAMBDA (Stream ID Region)
(PROG ((Value (NC.GetSketchSubstance Stream)))
(NC.SetScale ID (CADR Value))
(NC.SetRegionViewed ID (CADDR Value))
(RETURN (CAR Value))))))
(PutSubstanceFn , (FUNCTION NC.PutSketchSubstance))
(CopySubstanceFn , (FUNCTION NC.SketchCopySubstance))
(MarkSubstanceDirtyFn , (FUNCTION NC.MarkSketchDirty))
(SubstanceDirtyPFn , (FUNCTION NC.SketchDirtyP))
(CollectLinksInSubstanceFn , (FUNCTION NC.CollectReferencesInSketch)
)
(DeleteLinksInSubstanceFn , (FUNCTION
NC.DelReferencesToCardFromSketch))
(UpdateLinkIconsInSubstanceFn , (FUNCTION
NC.UpdateLinkImagesInSketch))
(InsertLinkInSubstanceFn , (FUNCTION NC.InsertLinkInSketch))
(TranslateWindowPositionToSubstancePositionFn
,
(FUNCTION NC.TranslateWindowPositionToSketchPosition))))
(QUOTE ((SubstanceDefaultWidth 400)
(SubstanceDefaultHeight 350)
(SubstanceLinkAnchorModesSupported T))))))
)
(NC.AddSketchSubstance)
(PUTPROPS NCSKETCHSUBSTANCE COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1538 9070 (NC.BringUpSketchCard 1548 . 2653) (NC.SketchDirtyP 2655 . 3098) (
NC.SketchCardCloseFn 3100 . 4386) (NC.SketchCopySubstance 4388 . 5439) (NC.MarkSketchDirty 5441 . 5796
) (NC.CollectReferencesInSketch 5798 . 8573) (NC.SketchBasedP 8575 . 9068)) (9456 9695 (
NC.TranslateWindowPositionToSketchPosition 9466 . 9693)) (9757 11299 (NC.AddSketchSubstance 9767 .
11297)))))
STOP