(FILECREATED "24-Apr-87 14:35:27" {QV}<NOTECARDS>1.3K>NEXT>NCSKETCHCARD.;41 29625
changes to: (VARS NCSKETCHCARDCOMS)
previous date: "23-Apr-87 20:57:15" {QV}<NOTECARDS>1.3K>NEXT>NCSKETCHCARD.;39)
(* Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCSKETCHCARDCOMS)
(RPAQQ NCSKETCHCARDCOMS [(* * Definition of the Sketch card type.)
[DECLARE: COPY FIRST (P (NC.LoadFileFromDirectories (QUOTE SKETCH)
(QUOTE LISPUSERSDIRECTORIES))
(NC.LoadFileFromDirectories (QUOTE KOTOSKETCHPATCHES]
(GLOBALVARS NC.SketchCardIcon NC.SketchTitleBarMenu NC.DeletedLinkImageObject
NC.UseDeletedLinkIconIndicatorsFlg)
(BITMAPS NC.SketchCardIcon)
(* * Basic functions)
(FNS NC.MakeSketchCard NC.BringUpSketchCard NC.SketchDirtyP NC.SketchTitleBarButtonEventFn
NC.SketchCardCloseFn NC.SketchCardShrinkFn NC.SketchCopySubstance NC.MarkSketchDirty
NC.CollectReferencesInSketch NC.GetSketchSubstance NC.PutSketchSubstance NC.PutCachedMap
NC.GetCachedMap NC.UpdateLinkImagesInSketch NC.DelReferencesToCardFromSketch
NC.ExternalizeLinkIconsInSketch NC.MakeExternalSketchCopy NC.SK.COPY.BUTTONEVENTFN)
(ADVISE CREATE.SKETCHW.COMMANDMENU)
(* * This stuff supports the "push-copy" method of copying links in NC)
(FNS NC.TranslateWindowPositionToSketchPosition)
(* * Special stuff for autoloading maps)
(FNS NC.FakeMapInputFn NC.FakeMapInsideFn)
[P (NC.StoreAutoloadFnFile (FUNCTION SK.MAP.INPUTFN)
(QUOTE NCMAPS)
(QUOTE NOTECARDSDIRECTORIES))
(NC.StoreAutoloadFnFile (FUNCTION SK.MAP.INSIDEFN)
(QUOTE NCMAPS)
(QUOTE NOTECARDSDIRECTORIES))
(NC.StoreAutoloadFnFile (FUNCTION SetCachedBitMap)
(QUOTE NCMAPS)
(QUOTE NOTECARDSDIRECTORIES))
(OR (FMEMB (QUOTE MAP)
SKETCH.ELEMENT.TYPE.NAMES)
(CREATE.SKETCH.ELEMENT.TYPE (QUOTE MAP)
"Map" "Forces autoload of MAP package." NIL NIL NIL NIL
(FUNCTION NC.FakeMapInputFn)
(FUNCTION NC.FakeMapInsideFn]
(* * Add sketch card type to CardType list)
(FNS NC.AddSketchCard NCAddStub.SketchCard)
(P (NC.AddSketchCard))
(P (if (NULL (GETD (QUOTE VIEWER.SCALE)))
then
(DEFINEQ (VIEWER.SCALE (LAMBDA (Window)
(WINDOWPROP Window (QUOTE SCALE])
(* * Definition of the Sketch card type.)
(DECLARE: COPY FIRST
(NC.LoadFileFromDirectories (QUOTE SKETCH)
(QUOTE LISPUSERSDIRECTORIES))
(NC.LoadFileFromDirectories (QUOTE KOTOSKETCHPATCHES))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.SketchCardIcon NC.SketchTitleBarMenu NC.DeletedLinkImageObject
NC.UseDeletedLinkIconIndicatorsFlg)
)
(RPAQ NC.SketchCardIcon (READBITMAP))
(21 18
"OOOOOH@@"
"H@@@@H@@"
"HGO@@H@@"
"HH@H@H@@"
"H@@G@H@@"
"HC@@HH@@"
"HDH@DH@@"
"HHD@BH@@"
"I@B@@H@@"
"I@B@@H@@"
"HHDONH@@"
"HDHHBH@@"
"HC@HBH@@"
"H@@HBH@@"
"H@@HBH@@"
"H@@ONH@@"
"H@@@@H@@"
"OOOOOH@@")
(* * Basic functions)
(DEFINEQ
(NC.MakeSketchCard
(LAMBDA (Card Title NoDisplayFlg) (* fgh: "30-Jun-86 23:13")
(* * rht 2/1/85: Added windowprop to prevent sketch asking about saving changes.)
(* * fgh 11/14/85 Updated to handle Card object.)
(* * rht 5/6/86 Replaced call to NC.SetupTitleBarMenu with calls to NC.InstallTitleBarButtonEventFn and
NC.InstallTitleBarLeftMenu and NC.InstallSketchTitleBarMiddleMenu.)
(* * fgh 6/30/86 Added NC.SK.COPY.BUTTONEVENTFN on Sketch Window. Added SKETCH.ADD.ELEMENT call when NoDisplayFlg)
(if NoDisplayFlg
then (NC.SetSubstance Card (SKETCH.ADD.ELEMENT NIL NIL))
Card
else (LET (Window CardType)
(SETQ CardType (NC.RetrieveType Card))
(SETQ Window (SKETCHW.CREATE NIL NIL (NC.DetermineDisplayRegion Card NIL)
(OR Title "Untitled")
NIL
(SKETCH.COMMANDMENU (NC.GetCardTypeField
MiddleButtonMenuItems
CardType))))
(WINDOWPROP Window (QUOTE DONTQUERYCHANGES)
T)
(WINDOWPROP Window (QUOTE COPYBUTTONEVENTFN)
(FUNCTION NC.SK.COPY.BUTTONEVENTFN))
(WINDOWPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.SketchCardShrinkFn))
(NC.InstallTitleBarButtonEventFn Window (FUNCTION
NC.SketchTitleBarButtonEventFn))
(NC.InstallTitleBarLeftMenu Window CardType)
(NC.SetSubstance Card (INSURE.SKETCH Window))
Window))))
(NC.BringUpSketchCard
[LAMBDA (Card Substance RegionOrPosition) (* rht: " 2-Mar-87 20:44")
(* Bring up a sketch card containing substance in
specified region)
(* * rht 2/1/85: Added windowprop to prevent sketch asking about saving changes.)
(* * rht 10/10/85: Now sets substance if was nil.)
(* * fgh 11/14/85 Updated to handle Card object.)
(* * rht 5/5/86: Replaced call to NC.SetupTitleBarMenu with calls to NC.InstallTitleBarButtonEventFn and
NC.InstallTitleBarLeftMenu and NC.InstallSketchTitleBarMiddleMenu.)
(* * fgh 6/30/86 Added NC.SK.COPY.BUTTONEVENTFN to sketch window. Made Substance to be INSURE.SKETCH of the sketch
window.)
(* * rht 11/16/86: Now moves window to RegionOrPosition if already up.)
(* * rht 3/2/87: No longer passes RegionViewed and Scale to SKETCHW.CREATE. SKETCHW.CREATE will extract them from
the imageobj.)
(LET ([SketchName (AND (NULL Substance)
(MKATOM (fetch (Card UID) of Card]
Region Title SketchViewer CardType)
[COND
[(SETQ SketchViewer (NC.FetchWindow Card))
(TOTOPW SketchViewer)
(if RegionOrPosition
then (SHAPEW SketchViewer (NC.DetermineDisplayRegion Card RegionOrPosition)))
(RPTQ 2 (FLASHW SketchViewer))
(TTY.PROCESS (WINDOWPROP SketchViewer (QUOTE PROCESS]
(T (SETQ CardType (NC.RetrieveType Card))
[SETQ SketchViewer (SKETCHW.CREATE (OR Substance SketchName)
NIL
(NC.DetermineDisplayRegion Card
RegionOrPosition)
(NC.RetrieveTitle Card)
NIL
(SKETCH.COMMANDMENU (NC.GetCardTypeField
MiddleButtonMenuItems
CardType]
(WINDOWPROP SketchViewer (QUOTE DONTQUERYCHANGES)
T)
(WINDOWPROP SketchViewer (QUOTE COPYBUTTONEVENTFN)
(FUNCTION NC.SK.COPY.BUTTONEVENTFN))
(WINDOWPROP SketchViewer (QUOTE SHRINKFN)
(FUNCTION NC.SketchCardShrinkFn))
(NC.InstallTitleBarButtonEventFn SketchViewer (FUNCTION
NC.SketchTitleBarButtonEventFn))
(NC.InstallTitleBarLeftMenu SketchViewer CardType)
(OR Substance (NC.SetSubstance Card (INSURE.SKETCH SketchViewer]
SketchViewer])
(NC.SketchDirtyP
[LAMBDA (Card) (* rht: " 2-Mar-87 21:10")
(* * 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.)
(* * fgh 11/14/85 Updated to handle Card object.)
(* * rht 3/2/87: Took out calls to NC.FetchSavedRegion and NC.FetchScale. Also fixed bug %#419: sketch doing
needless save after Put.)
(EQ (WINDOWPROP (NC.FetchWindow Card)
(QUOTE SKETCHCHANGED))
T])
(NC.SketchTitleBarButtonEventFn
(LAMBDA (Window) (* rht: " 6-May-86 12:12")
(* * if inside title region and left button down, bringup left button title menu, otherwise just call the
oldbuttoneventfn)
(LET (LeftButtonMenu)
(if (OR (INSIDEP (DSPCLIPPINGREGION NIL Window)
(LASTMOUSEX Window)
(LASTMOUSEY Window))
(LASTMOUSESTATE MIDDLE))
then (APPLY* (WINDOWPROP Window (QUOTE OLDBUTTONEVENTFN))
Window)
elseif (type? MENU (SETQ LeftButtonMenu (WINDOWPROP Window (QUOTE
TitleBarLeftButtonMenu))))
then (APPLY* (OR (MENU LeftButtonMenu)
(FUNCTION NILL))
Window)))))
(NC.SketchCardCloseFn
[LAMBDA (CardIdentifier) (* rht: "16-Oct-86 17:01")
(* 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.)
(* * fgh 11/14/85 Updated to handle Card object.)
(* * rht 10/16/86: Removed call to NC.DeactivateCard.)
(LET (Card Window OldRegion NewRegion)
(SETQ Card (NC.CoerceToCard CardIdentifier))
(SETQ Window (NC.FetchWindow Card))
[COND
(Window (for Viewer in (ALL.SKETCH.VIEWERS (NC.FetchSubstance Card))
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.SketchCardShrinkFn
(LAMBDA (W) (* fgh: "14-Nov-85 20:52")
(* * Check to make sure that icon's title agrees with card title. If not, retitle the icon.
If this is first shrink then create a new icon and fill in title.)
(* * fgh 11/14/85 Updated to handle Card object.)
(PROG ((OldIconTitle (WINDOWPROP W (QUOTE SKETCH.ICON.TITLE)))
(Icon (WINDOWPROP W (QUOTE ICON)))
(Card (NC.CoerceToCard W))
IconTitle)
(COND
((NOT Icon)
(SK.SHRINK.ICONCREATE W)
(SETQ Icon (WINDOWPROP W (QUOTE ICON)))))
(COND
((NOT (EQUAL OldIconTitle (SETQ IconTitle (CONCAT "NC: " (NC.RetrieveTitle
Card)))))
(WINDOWPROP W (QUOTE SKETCH.ICON.TITLE)
IconTitle)
(ICONTITLE IconTitle NIL NIL Icon))))))
(NC.SketchCopySubstance
(LAMBDA (Card FromStream ToStream Length) (* fgh: "21-Nov-85 21:12")
(* * Copy a sketch substance from FromStream to ToStream.)
(* * fgh 11/14/85 Updated to handle Card object.)
(* * fgh 11/20/85 NoteCards now handles the start and end ptrs -- passing the from ptrs as args and properly
setting the to ptrs.)
(* * fgh 11/21/85 Now passes length instead of start and end ptrs.)
(* * Copy the bytes)
(LET* ((FromStartPtr (GETFILEPTR FromStream))
(FromEndPtr (PLUS Length FromStartPtr)))
(COPYBYTES FromStream ToStream FromStartPtr FromEndPtr))
T))
(NC.MarkSketchDirty
(LAMBDA (Card ResetFlg) (* fgh: "14-Nov-85 20:52")
(* * Mark or unmark sketch as having been changed.)
(* * rht 2/1/85: Now goes through window prop rather than FILEPKG.)
(* * fgh 11/14/85 Updated to handle Card object.)
(WINDOWPROP (NC.FetchWindow Card)
(QUOTE SKETCHCHANGED)
ResetFlg)))
(NC.CollectReferencesInSketch
(LAMBDA (Card CheckAndDeleteFlg ReturnLinkIconsFlg ReturnLocationsFlg)
(* fgh: "17-Nov-85 16:20")
(* * Return a list of all links in sketch substance Substance. If CheckAndDeleteFlg, then delete any links found
that are not valid links.)
(* * rht 8/20/85: Rewritten to use Richard's sketch programmer's interface. Eliminates references to sketch
records.)
(* * fgh 11/14/85 Updated to handle Card object.)
(LET ((SketchSubstance (NC.FetchSubstance Card))
DirtyFlg)
(CONS (for SketchElt in (SKETCH.LIST.OF.ELEMENTS SketchSubstance
(FUNCTION
NC.LinkIconSketchElementP))
bind LinkIcon CollectItem ActualLink
when (PROGN (SETQ ActualLink (NC.FetchLinkFromLinkIcon (SETQ LinkIcon
(
SKETCH.IMAGEOBJ.OF.ELEMENT
SketchElt))))
(COND
((NULL CheckAndDeleteFlg)
(* No checking required)
T)
((AND (LISTP CheckAndDeleteFlg)
(FMEMB (fetch (Link DestinationCard) of
ActualLink)
CheckAndDeleteFlg))
(* Already checked since ID cached on
CheckAndDeleteFlg list)
T)
((NC.ValidLinkP ActualLink)
(* Link is valid)
T)
(T (* Link is bad. Replace it with the DeletedLink image
object.)
(NC.DeleteLinkIconSketchElement SketchElt Card)
(SETQ DirtyFlg T)
NIL)))
collect (SETQ CollectItem (COND
(ReturnLinkIconsFlg LinkIcon)
(T ActualLink)))
(COND
(ReturnLocationsFlg (CONS CollectItem (SKETCH.POSITION.OF.ELEMENT
SketchElt)))
(T CollectItem)))
DirtyFlg))))
(NC.GetSketchSubstance
[LAMBDA (Card Length Stream SubstanceVersion) (* rht: "28-Feb-87 21:40")
(* Get sketch substance from Database stream. Database stream is positioned. READ the global sketch description,
the locasl sketch scale and region viewed. Also read in any cached bit maps for the MAPS system.)
(* * fgh 11/14/85 Updated to handle Card and NoteFile objects.)
(* * fgh 11/20/85 NoteCards now passes start and enptrs down.)
(* * fgh 11/21/85 Now passed Length instead of start and end ptrs.)
(* * rht 1/23/86: Now takes Stream as arg instead of computing from Card.)
(* * rht 11/1/86: Now uses our readtable when reading.)
(* * rht 2/28/87: Now uses new style of storing sketch on file whereby we package as imageobj.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(* * Get the substance)
(SELECTQ SubstanceVersion
((0 -1)
(* * Old style wrote down Scale and RegionViewed separately.)
(LET ((Sketch (HREAD Stream)))
(NC.SetScale Card (READ Stream NC.OrigReadTable))
(NC.SetRegionViewed Card (READ Stream NC.OrigReadTable))
(while (EQ (READ Stream NC.OrigReadTable)
(QUOTE %###CACHEDMAP###))
do (NC.GetCachedMap Stream))
Sketch))
(1
(* * New style expects sketch to be packaged as imageobj.)
(LET ((Sketch (HREAD Stream)))
(while (EQ (READ Stream NC.OrigReadTable)
(QUOTE %###CACHEDMAP###))
do (NC.GetCachedMap Stream))
Sketch))
NIL])
(NC.PutSketchSubstance
[LAMBDA (Card Stream) (* rht: " 2-Mar-87 20:42")
(* Put the sketch substance for card ID to the database. Store the global sketch descriptor, the scale and region
viewed for ID and any cached bit maps.)
(* * fgh 11/14/85 Updated to handle Card object.)
(* * fgh 11/20/85 NoteCards now takes care of setting the start and end pointers for the substance.)
(* * rht 1/23/86: Now takes Stream as arg instead of computing from Card.)
(* * fgh 2/6/86 Now returns version number.)
(* * fgh&rht 8/25/86 Changed call to NC.PutCachedMap to remove use of SCREENELT record.)
(* * rht&pmi 10/15/86: Changed outdated SK.REGION.VIEWED call to SKETCH.REGION.VIEWED.)
(* * rht 11/1/86: Now uses our readtable when printing.)
(* * rht 2/28/87: Writes out sketches by first packaging as imageobject. This changes the format on the file, since
we no longer need to write down region and scale separately.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(LET ((Substance (NC.FetchSubstance Card))
(Window (NC.FetchWindow Card)))
(HPRINT (if (OPENWP Window)
then (MAKE.IMAGE.OBJECT.OF.SKETCH Window)
else Substance)
Stream NIL T)
(AND Window (for Element in (SKETCH.LIST.OF.ELEMENTS (INSURE.SKETCH Substance)
[FUNCTION (LAMBDA (Element)
(EQ (
GETSKETCHELEMENTPROP
Element
(QUOTE TYPE))
(QUOTE MAP]
T)
do (NC.PutCachedMap Element Window Stream)))
(PRINT (QUOTE %###ENDSKETCH###)
Stream NC.OrigReadTable)
1])
(NC.PutCachedMap
[LAMBDA (SketchMapElement SketchWindow Stream) (* rht: " 1-Nov-86 15:52")
(* Put a cached bit map corresponding to MapScreenElt
onto database file)
(* * 8/25/86 fgh&rht Removed use of SCREENELT record and replaced with call to CacheSpecsFromMapSketchElement which
is defined in the MAP package.)
(* * rht 11/1/86: Now uses our readtable when printing.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(LET (CacheSpecs BitMap)
(AND (LISTP (SETQ CacheSpecs (CacheSpecsFromMapSketchElement SketchMapElement
SketchWindow)))
(for CacheSpec in CacheSpecs
do (BITMAPP (SETQ BitMap (APPLY (FUNCTION FetchCachedBitMap)
CacheSpec)))
(PRINT (QUOTE ###CACHEDMAP###)
Stream NC.OrigReadTable)
(PRINT CacheSpec Stream NC.OrigReadTable)
(HPRINT BitMap Stream T T])
(NC.GetCachedMap
[LAMBDA (Stream) (* rht: " 1-Nov-86 15:54")
(* Read a bit map from the file and then put it onto
the cached maps list)
(* * FGH 9/28/85 Updated to handle new map changes. In particular, caching now done on the map resolution and noit
on the x and y offsets.)
(* * rht 10/10/86: Replaced APPLY of SetCachedBitMap with NC.AutoloadApply so that NCMAPS will get autoloaded.)
(* * rht 11/1/86: Now uses our readtable when reading.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(LET (CacheSpecs BitMap)
(SETQ CacheSpecs (READ Stream NC.OrigReadTable))
[COND
((EQ (LENGTH CacheSpecs)
8)
(* * Old Scheme for cahcing)
(SETQ CacheSpecs (CONS (QUOTE HIGH)
(CDDR CacheSpecs]
(SETQ BitMap (HREAD Stream))
(AND CacheSpecs BitMap (NC.AutoloadApply (FUNCTION SetCachedBitMap)
(CONS BitMap CacheSpecs])
(NC.UpdateLinkImagesInSketch
(LAMBDA (SourceCard DestinationCard) (* fgh: "17-Nov-85 16:32")
(* For now do nothing since Link Images in Sketch have
no titles.)
(* * rht 8/20/85: Rigged this to use Richard's new sketch programmer's interface.)
(* * fgh 11/17/85 Updated to handle card object.)
(LET ((SketchWin (NC.FetchWindow SourceCard)))
(for SketchElement in (SKETCH.LIST.OF.ELEMENTS SketchWin (FUNCTION
NC.LinkIconSketchElementP))
bind FoundAtLeastOneFlg when (NC.SameCardP DestinationCard
(fetch (Link DestinationCard)
of (NC.FetchLinkFromLinkIcon
(SKETCH.IMAGEOBJ.OF.ELEMENT
SketchElement))))
do (SKETCH.ELEMENT.CHANGED SketchWin SketchElement)
(SETQ FoundAtLeastOneFlg T)
finally (COND
(FoundAtLeastOneFlg (NC.MarkCardDirty SourceCard)))))))
(NC.DelReferencesToCardFromSketch
[LAMBDA (SourceCard LinkOrDestinationCard Don'tCreateDeletedImageObjFlg)
(* rht: " 4-Nov-86 14:52")
(* * Remove all Link Icons pointing to Destination from the sketch Substance.)
(* * rht 8/20/85: Rewritten to use Richard's sketch programmer's interface. Eliminates references to sketch
records. I'm changing the innards of the affected link icons rather than deleting them and reinserting.
That's because deleting the icon would cause a recursive call.)
(* * kirk 14Nov85: deleted use of LinkID)
(* * rht 11/4/86: Now takes Don'tCreateDeletedImageObjFlg arg.)
(PROG ((LinkFlg (type? Link LinkOrDestinationCard))
DestinationCard SketchSubstance)
(COND
[LinkFlg (OR (NC.CardP SourceCard)
(SETQ SourceCard (fetch (Link SourceCard) of LinkOrDestinationCard]
(T (SETQ DestinationCard LinkOrDestinationCard)))
(SETQ SketchSubstance (NC.FetchSubstance SourceCard))
(for SketchElement in (SKETCH.LIST.OF.ELEMENTS SketchSubstance
(FUNCTION
NC.LinkIconSketchElementP))
bind LinkIcon when [PROGN (SETQ LinkIcon (SKETCH.IMAGEOBJ.OF.ELEMENT
SketchElement))
(COND
(LinkFlg (NC.SameLinkP LinkOrDestinationCard
(NC.FetchLinkFromLinkIcon
LinkIcon)))
(T (NC.SameCardP DestinationCard
(fetch (Link DestinationCard)
of (
NC.FetchLinkFromLinkIcon
LinkIcon]
do (NC.DeleteLinkIconSketchElement SketchElement SourceCard
Don'tCreateDeletedImageObjFlg])
(NC.ExternalizeLinkIconsInSketch
(LAMBDA (Sketch) (* rht: "26-Mar-86 12:26")
(* * Smashes all link icons in Sketch with external link icons.)
(for SketchElement in (SKETCH.LIST.OF.ELEMENTS Sketch (FUNCTION NC.LinkIconSketchElementP)
T)
do (LET* ((LinkIcon (SKETCH.IMAGEOBJ.OF.ELEMENT SketchElement))
(Link (NC.FetchLinkFromLinkIcon LinkIcon)))
(NC.CoerceToExternalPutLinkIcon LinkIcon (fetch (Link SourceCard) of Link)
(fetch (Link DestinationCard) of Link)
(fetch (Link Label) of Link))))
Sketch))
(NC.MakeExternalSketchCopy
[LAMBDA (SketchViewerOrImageObj) (* rht: "22-Apr-87 20:54")
(* * Make a copy of the sketch smashing any link icons.)
(* * rht 4/22/87: Now installs proper grid, scale and region viewed in the copy. Now returns a sketch imageobj.)
(LET ((SketchCopy (SKETCH.ADD.ELEMENT NIL NIL)))
(SKETCH.COPY.ELEMENTS (SKETCH.ELEMENTS.OF.SKETCH (INSURE.SKETCH SketchViewerOrImageObj)
)
SketchCopy)
(NC.ExternalizeLinkIconsInSketch SketchCopy)
(MAKE.IMAGE.OBJECT.OF.SKETCH SketchCopy (SKETCH.REGION.VIEWED SketchViewerOrImageObj)
(SKETCH.VIEWER.SCALE SketchViewerOrImageObj)
(SKETCH.VIEWER.GRID SketchViewerOrImageObj])
(NC.SK.COPY.BUTTONEVENTFN
(LAMBDA (Window) (* fgh: "30-Jun-86 23:50")
(* * Check to see if the TTY PROCESS is a Select NoteCards, if so then ask get user to choose a link icon and pass
it back. Otherwise, just call the normal sketch copybuttoneventfn.)
(if (AND (WINDOWP (PROCESSPROP (TTY.PROCESS)
(QUOTE WINDOW)))
(WINDOWPROP (PROCESSPROP (TTY.PROCESS)
(QUOTE WINDOW))
(QUOTE SelectingCards)))
then
(* * Okay, TTY is a select NC process.)
(LET ((ChosenElement (SKETCH.GET.ELEMENTS
Window T (SKETCH.LIST.OF.ELEMENTS
(INSURE.SKETCH Window)
(FUNCTION (LAMBDA (Element)
(AND (EQ (GETSKETCHELEMENTPROP Element
(QUOTE TYPE))
(QUOTE SKIMAGEOBJ))
(NC.LinkIconImageObjP (GETSKETCHELEMENTPROP
Element
(QUOTE DATA))))))))))
(if ChosenElement
then (COPYINSERT (GETSKETCHELEMENTPROP ChosenElement (QUOTE DATA)))))
else
(* * TTY is not select NC, do what sketch does.)
(SK.COPY.BUTTONEVENTFN Window))))
)
(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 (Card Window WindowPositionX WindowPositionY) (* fgh: " 6-Feb-86 22:10")
(* * fgh 2/6/86 Added Card argument.)
(create POSITION
XCOORD ← WindowPositionX
YCOORD ← WindowPositionY)))
)
(* * Special stuff for autoloading maps)
(DEFINEQ
(NC.FakeMapInputFn
[LAMBDA (SketchWin) (* rht: " 9-Oct-86 14:55")
(* * This just to force autoload of the NCMAPS library package.)
(NC.AutoloadApply* (FUNCTION SK.MAP.INPUTFN)
SketchWin])
(NC.FakeMapInsideFn
[LAMBDA (Elem Region) (* rht: " 9-Oct-86 18:03")
(* * This just to force autoload of the NCMAPS library package.)
(NC.AutoloadApply* (FUNCTION SK.MAP.INSIDEFN)
Elem Region])
)
(NC.StoreAutoloadFnFile (FUNCTION SK.MAP.INPUTFN)
(QUOTE NCMAPS)
(QUOTE NOTECARDSDIRECTORIES))
(NC.StoreAutoloadFnFile (FUNCTION SK.MAP.INSIDEFN)
(QUOTE NCMAPS)
(QUOTE NOTECARDSDIRECTORIES))
(NC.StoreAutoloadFnFile (FUNCTION SetCachedBitMap)
(QUOTE NCMAPS)
(QUOTE NOTECARDSDIRECTORIES))
(OR (FMEMB (QUOTE MAP)
SKETCH.ELEMENT.TYPE.NAMES)
(CREATE.SKETCH.ELEMENT.TYPE (QUOTE MAP)
"Map" "Forces autoload of MAP package." NIL NIL NIL NIL
(FUNCTION NC.FakeMapInputFn)
(FUNCTION NC.FakeMapInsideFn)))
(* * Add sketch card type to CardType list)
(DEFINEQ
(NC.AddSketchCard
[LAMBDA NIL (* rht: "28-Feb-87 21:28")
(* * fgh 11/14/85: Updated to conform to merging of cardTypes and SubstanceTypes.)
(* * Added LinkIconAttachedBitMap field.)
(* * rht 2/28/87: Ripped out old LAMBDA wrapper around GetFn.)
(DECLARE (GLOBALVARS NC.SketchCardIcon))
(NC.AddCardType (QUOTE Sketch)
(QUOTE NoteCard)
[BQUOTE ((MakeFn , (FUNCTION NC.MakeSketchCard))
(EditFn , (FUNCTION NC.BringUpSketchCard))
(QuitFn , (FUNCTION NC.SketchCardCloseFn))
(GetFn , (FUNCTION NC.GetSketchSubstance))
(PutFn , (FUNCTION NC.PutSketchSubstance))
(CopyFn , (FUNCTION NC.SketchCopySubstance))
(MarkDirtyFn , (FUNCTION NC.MarkSketchDirty))
(DirtyPFn , (FUNCTION NC.SketchDirtyP))
(CollectLinksFn , (FUNCTION NC.CollectReferencesInSketch))
(DeleteLinksFn , (FUNCTION NC.DelReferencesToCardFromSketch))
(UpdateLinkIconsFn , (FUNCTION NC.UpdateLinkImagesInSketch))
(InsertLinkFn , (FUNCTION NC.InsertLinkInSketch))
(TranslateWindowPositionFn , (FUNCTION
NC.TranslateWindowPositionToSketchPosition))
(MiddleButtonMenuItems , (SKETCH.COMMANDMENU.ITEMS NIL T]
(BQUOTE ((DefaultWidth 400)
(DefaultHeight 350)
(LinkAnchorModesSupported T)
(LinkDisplayMode Title)
(DisplayedInMenuFlg T)
(LinkIconAttachedBitMap , NC.SketchCardIcon])
(NCAddStub.SketchCard
[LAMBDA NIL (* rht: " 7-Nov-86 16:33")
(* * kirk 18Jun86 Add the Sketch card stub)
(* * rht 11/7/86: Fixed typo, changing a QUOTE to BQUOTE.)
(DECLARE (GLOBALVARS NC.SketchCardIcon))
(NC.AddCardTypeStub (QUOTE Sketch)
(QUOTE NoteCard)
(QUOTE NCSKETCHCARD)
NIL
(BQUOTE ((DisplayedInMenuFlg T)
(LinkIconAttachedBitMap , NC.SketchCardIcon])
)
(NC.AddSketchCard)
[if (NULL (GETD (QUOTE VIEWER.SCALE)))
then
(DEFINEQ (VIEWER.SCALE (LAMBDA (Window)
(WINDOWPROP Window (QUOTE SCALE]
(PUTPROPS NCSKETCHCARD COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2939 25579 (NC.MakeSketchCard 2949 . 4558) (NC.BringUpSketchCard 4560 . 7112) (
NC.SketchDirtyP 7114 . 7710) (NC.SketchTitleBarButtonEventFn 7712 . 8514) (NC.SketchCardCloseFn 8516
. 9893) (NC.SketchCardShrinkFn 9895 . 10824) (NC.SketchCopySubstance 10826 . 11549) (
NC.MarkSketchDirty 11551 . 11979) (NC.CollectReferencesInSketch 11981 . 14123) (NC.GetSketchSubstance
14125 . 15857) (NC.PutSketchSubstance 15859 . 17734) (NC.PutCachedMap 17736 . 18764) (NC.GetCachedMap
18766 . 19910) (NC.UpdateLinkImagesInSketch 19912 . 20967) (NC.DelReferencesToCardFromSketch 20969 .
22819) (NC.ExternalizeLinkIconsInSketch 22821 . 23503) (NC.MakeExternalSketchCopy 23505 . 24298) (
NC.SK.COPY.BUTTONEVENTFN 24300 . 25577)) (25800 26106 (NC.TranslateWindowPositionToSketchPosition
25810 . 26104)) (26154 26712 (NC.FakeMapInputFn 26164 . 26434) (NC.FakeMapInsideFn 26436 . 26710)) (
27295 29381 (NC.AddSketchCard 27305 . 28862) (NCAddStub.SketchCard 28864 . 29379)))))
STOP