(FILECREATED "16-Oct-87 11:37:08" {QV}<NOTECARDS>1.3KNEXT>RGPATCH061.;5 107842
changes to: (VARS RGPATCH061COMS)
previous date: "16-Oct-87 11:34:35" {QV}<NOTECARDS>1.3KNEXT>RGPATCH061.;4)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RGPATCH061COMS)
(RPAQQ RGPATCH061COMS [(* * rg 9/28/87 This patch redefines the NoteCardType datatype to include
new fields for MakeReadOnlyFn and MakeReadWriteFn. Most of the functions
in this patch are simply recompiled.)
[DECLARE: COPY FIRST (P (NC.LoadFileFromDirectories (QUOTE NCSKETCHCARD))
(NC.LoadFileFromDirectories (QUOTE NCBROWSERCARD))
(NC.LoadFileFromDirectories (QUOTE NCSEARCHCARD))
(NC.LoadFileFromDirectories (QUOTE NCDOCUMENTCARD))
(NC.LoadFileFromDirectories (QUOTE NCDOCUMENTCARD))
(NC.LoadFileFromDirectories (QUOTE NCREPAIR))
(NC.LoadFileFromDirectories (QUOTE
NCCONVERTVERSION2TO3))
(NC.LoadFileFromDirectories (QUOTE NCLINKINDEXCARD]
(* * changes to NCCARDS)
(FNS NC.CardDirtyP NC.CollectReferences NC.EditNoteCard NC.MakeNoteCard
NC.QuitCard NC.MarkCardDirty NC.FetchDefaultHeight NC.FetchDefaultWidth
NC.FetchLinkAnchorModesSupported NC.FetchLinkDisplayMode
NC.FetchLinkIconAttachedBitMap NC.InstallTitleBarMiddleMenu)
(* * changes to NCREPAIR)
(FNS NC.CardSubstanceVersionInspector NC.RobustGetSubstance)
(* * changes to NCTYPESMECH)
(RECORDS NoteCardType)
(FNS NC.IsSubTypeOfP NC.ListOfCardTypes NC.RecomputeCardType
NC.PropagateCardTypeFieldsDownward NC.SubTypesOfCardType
NC.InheritFieldsFromSuperType NC.AutoLoadCardType NC.MakeCardTypesList
NC.AddCardType NC.CardTypeRecord NC.ModifyCardType)
(* * changes to NCPROGINT)
(FNS NCP.CardTypeSuper NCP.CardTypeLinkDisplayMode)
(* * changes to NCHASHCARD)
(FNS NC.RegistryCardMakeFn)
(* * changes to NCTEXTCARD)
(FNS NC.InstallTextTitleBarMiddleMenu)
(* * changes to NCSKETCHCARD)
(FNS NC.MakeSketchCard NC.BringUpSketchCard)
(* * changes to NCFILEBOXCARD)
(FNS NC.MakeFileBox NC.AddFileBoxCard)
(* * changes to NCBROWSERCARD)
(FNS NC.BringUpBrowserCard NC.BrowserCardQuitFn NC.AddBrowserCard)
(* * changes to NCSEARCHCARD)
(FNS NC.MakeSearchCard)
(* * changes to NCDOCUMENTCARD)
(FNS NC.MakeDocument)
(* * changes to NCLINKINDEXCARD)
(FNS NC.MakeLinkIndex NC.AddLinkIndexCard)
(* * changes to NCLINKS)
(FNS NC.DelReferencesToCard NC.FetchLinkIconForLink NC.UpdateLinkImages)
(* * changes to NCINTERFACE)
(FNS NC.InstallTitleBarLeftMenu)
(* * changes to NOTECARDS)
(FNS NC.PostGreet)
(* * changes to NCDATABASE)
(FNS NC.PutMainCardData NC.FixUpLinksInCardCopy NC.GetMainCardData)
(* * changes to NCCONVERTVERSION2TO3)
(FNS NC.ReadVersion2MainCardData)
(* * following code reconstructs existing card types, or tries to, at least
- do not include in integration)
(P (LET [(TypeNames (REMOVE (QUOTE NoteCard)
(LET (collection)
[MAPHASH NC.CardTypes
(FUNCTION (LAMBDA (REC NAME)
(push collection
NAME]
collection]
(CLRHASH NC.CardTypes)
(NC.MakeCardTypesList)
[for fn in (QUOTE ((NC.AddCrossFileLink . CrossFileLink)
(NC.AddHashCard . Hash)
(NC.AddRegistryCard . Registry)
(NC.AddTextCard . Text)
(NC.AddSketchCard . Sketch)
(NC.AddGraphCard . Graph)
(NC.AddFileBoxCard . FileBox)
(NC.AddBrowserCard . Browser)
(NC.AddSearchCard . Search)
(NC.AddDocumentCard . Document)
(NC.AddLinkIndexCard . LinkIndex)
(NC.AddListCard . List)))
do
(if (GETD (CAR fn))
then
(APPLY (CAR fn))
(SETQ TypeNames (REMOVE (CDR fn)
TypeNames]
[for type in NOTECARDTYPESTUBS do
(LET [(StubFn (PACK* (QUOTE NCAddStub.)
type
(QUOTE Card]
(if (AND (MEMB type TypeNames)
(NOT (GETHASH type NC.CardTypes))
(GETD StubFn))
then
(APPLY StubFn)
(SETQ TypeNames (REMOVE type TypeNames]
(if TypeNames then (PRINTOUT T
"The following card types need to be redefined: "
TypeNames T])
(* * rg 9/28/87 This patch redefines the NoteCardType datatype to include new fields for
MakeReadOnlyFn and MakeReadWriteFn. Most of the functions in this patch are simply recompiled.)
(DECLARE: COPY FIRST
(NC.LoadFileFromDirectories (QUOTE NCSKETCHCARD))
(NC.LoadFileFromDirectories (QUOTE NCBROWSERCARD))
(NC.LoadFileFromDirectories (QUOTE NCSEARCHCARD))
(NC.LoadFileFromDirectories (QUOTE NCDOCUMENTCARD))
(NC.LoadFileFromDirectories (QUOTE NCDOCUMENTCARD))
(NC.LoadFileFromDirectories (QUOTE NCREPAIR))
(NC.LoadFileFromDirectories (QUOTE NCCONVERTVERSION2TO3))
(NC.LoadFileFromDirectories (QUOTE NCLINKINDEXCARD))
)
(* * changes to NCCARDS)
(DEFINEQ
(NC.CardDirtyP
[LAMBDA (Card) (* fgh: " 5-Feb-86 20:01")
(* * Return T if card ID has been changed.)
(* * rht 2/1/85: Now also checks flag on prop list.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(OR (NC.ApplyFn DirtyPFn Card)
(NC.FetchSubstanceDirtyFlg Card])
(NC.CollectReferences
[LAMBDA (Card CheckAndDeleteFlg ReturnLinkIconsFlg ReturnLocationsFlg)
(* fgh: " 5-Feb-86 19:54")
(* * Collect all the links in a card specified by ID. RETURNS the CONS of a list of link identifiers {described
below} and a dirtyflg that is non-NIL if the Substance of ID has been modified {i.e., when a non-valid link is
found and CheckAndDeleteFlg is NIL}. IF CheckAndDeleteFlg is non-NIL checks for valid links and deletes those that
are not valid. If ReturnLinkIconsFlg is NIL, returns link icons. Otherwise, returns links. If ReturnLinkIconsFlg is
NIL, returns just the links/link icons. Otherwise, returns the CONS of link/link icon and the type-specific
location of the link icon in the card.)
(* * fgh 11/12/85 Updated to handle Card objects.)
(* * rht 12/19/85: Fixed to handle types with no CollectReferencesFn defined.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(COND
((NC.ActiveCardP Card)
(NC.ApplyFn CollectLinksFn Card CheckAndDeleteFlg ReturnLinkIconsFlg ReturnLocationsFlg))
(T (NC.ReportError "NC.CollectReferences" (CONCAT "Attempt to call with inactive card: "
Card])
(NC.EditNoteCard
[LAMBDA (Card RegionOrPosition TypeSpecificArgs) (* rht: "13-May-87 11:04")
(* * Bring the already created NoteCard specified by ID onto the screen at Region or Position specified by
RegionOrPosition)
(* * fgh 11/11/85: Updated to handle new Card object.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * kirk 15May86 Added call to NC.AttachNoteFileName)
(* * rht 7/13/86: Added TypeSpecificArgs arg.)
(* * kef 7/16/86: Added NC.ObtainCardEditPermission.)
(* * kef 8/7/86: Added check to make sure that applying the EditFn worked. If not, then release those write locks,
thus keeping the writelock count consistent.)
(* * fgh 8/30/86 Converted APPLY* to NC.ApplyFn.)
(* * rht 10/6/86: Added checks before doing WINDOWPROP calls in case there was a recursive call to
NC.EditNoteCard.)
(* * rg 3/30/87 added NC.ProtectedCardOperation wrapper)
(* * rht 5/13/87: Added call to new NC.InstallCopyButtonEventFn.)
(DECLARE (GLOBALVARS NC.ShowNoteFileOnCards))
(NC.ProtectedCardOperation Card "Edit NoteCard" NIL (RESETSAVE (CURSOR WAITINGCURSOR))
(PROG (NoteCardType Window Substance EditResult)
[COND
((AND (NC.ActiveCardP Card)
(NC.ObtainEditPermission Card))
(SETQ Substance (NC.FetchSubstance Card)))
((NC.ObtainEditPermission Card)
(NC.GetNoteCard Card)
(SETQ Substance (NC.FetchSubstance Card)))
(T (RETURN (NC.CardPartBusy Card
(QUOTE (SUBSTANCE TOLINKS
GLOBALTOLINKS
PROPLIST]
(SETQ NoteCardType (NC.RetrieveType Card))
(COND
([AND (SETQ EditResult
(ERSETQ (NC.ApplyFn EditFn Card Substance
RegionOrPosition
TypeSpecificArgs)))
(WINDOWP (SETQ Window (CAR EditResult]
(WINDOWADDPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.QuitCard)
(QUOTE FIRST))
(OR (NC.CardP (WINDOWPROP Window (QUOTE
NoteCardObject)))
(WINDOWPROP Window (QUOTE NoteCardObject)
Card))
(NC.InstallCopyButtonEventFn Window)
(if NC.ShowNoteFileOnCards
then (NC.AttachNoteFileName Window)))
(T (* At this point, we've obtain the write locks but the
edit failed, so we'd better release them)
(for CardPart in (QUOTE (SUBSTANCE TOLINKS
GLOBALTOLINKS
PROPLIST))
do (NC.ApplyFn ReleaseWritePermissionFn Card
CardPart))
(RETURN)))
(RETURN Window])
(NC.MakeNoteCard
[LAMBDA (NoteCardType NoteFile Title NoDisplayFlg TypeSpecificArgs Card)
(* rht: "24-Jul-87 19:40")
(* Make a new note card of type NoteCardType.
If type note specified, ask the user.)
(* * rht 2/1/85: Added call to NC.MarkCardDirty.)
(* * fgh 10/15/85 Added extra DatabaseStream argument for use by caching mechanism)
(* * fgh 11/11/85: Updated to handle new Card object.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * kirk 15May86 Added call to NC.AttachNoteFileName)
(* * rht 7/4/86: Now checks for read-only notefile before proceeding.)
(* * kef 8/4/86: Updated to pass NoteCardType argument on to NC.GetNewCard.)
(* * rht 7/24/87: Replaced WINDOWPROP thing with call to NC.InstallCopyButtonEventFn.)
(if (NC.ReadOnlyNoteFileP NoteFile)
then NIL
else (LET (ReturnValue Window)
(COND
([SETQ NoteCardType (OR NoteCardType (NC.AskNoteCardType
(fetch (NoteFile Menu) of NoteFile]
(SETQ Card (OR (PROGN (type? Card Card)
Card)
(NC.GetNewCard NoteFile NoteCardType)))
(NC.SetNewCardFlg Card T)
(NC.ActivateCard Card)
(NC.SetType Card NoteCardType)
[COND
((OR [NULL (ERSETQ (SETQ ReturnValue (NC.ApplyFn MakeFn Card Title
NoDisplayFlg
TypeSpecificArgs]
(NULL ReturnValue))
(NC.SetStatus Card (QUOTE DELETED))
(NC.DeactivateCard Card T))
(T (SETQ Window (WINDOWP ReturnValue))
[COND
((NULL (NC.RetrieveTitle Card))
[SETQ Title (NC.SetTitle Card (SETQ Title
(COND
((STRINGP Title)
Title)
((AND Title (OR (LITATOM Title)
(NUMBERP Title))
)
(MKSTRING Title))
(T "Untitled"]
(AND Window (WINDOWPROP Window (QUOTE TITLE)
Title)))
(T (NC.SetTitle Card (MKSTRING (NC.RetrieveTitle Card]
(COND
(Window (WINDOWADDPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.QuitCard)
(QUOTE FIRST))
(WINDOWPROP Window (QUOTE NoteCardObject)
Card)
(NC.InstallCopyButtonEventFn Window)))
(NC.SetTitleDirtyFlg Card T) (* Reset the type in case of recursive calls change
the type. Always want the highest level type in a
recursive descent)
(NC.SetType Card NoteCardType)
(* Insure that a link ptr is set up during the first
save)
(NC.SetLinksDirtyFlg Card T)
(NC.SetPropListDirtyFlg Card T)
(* Mark that substance is dirty.)
(NC.MarkCardDirty Card T)
(if NC.ShowNoteFileOnCards
then (NC.AttachNoteFileName Window]
ReturnValue])
(NC.QuitCard
[LAMBDA (CardIdentifier CallCloseWFlg DontSaveFlg DontRecacheFlg InterestedWindow OperationMsg
QuietFlg Don'tDeactivateFlg) (* pmi: "16-Sep-87 10:21")
(* * Force note card specified by ID to quit or stop)
(* * rht 2/9/85: New arg DontSaveFlg prevents NC.CardSaveFn from being called. Used when aborting a card.
This is NOT equivalent to NC.QuitWithoutSaving.)
(* * rht 6/25/85: Now moves card off screen before saving if NC.CloseCardsOffScreenFlg is non-nil.)
(* * rht 6/25/85: Brought the insure proper filing check back here from NC.CardSaveFn. Bails out if user cancelled
operation inside of NC.InsureProperFiling)
(* * fgh 11/11/85: Updated to handle CardID and CardInfo objects.)
(* * fgh 1/16/86 Put in code to insure that if one of the TopLevelCards is quit then it is reactivated immedialtely
to make sure it stays cached for fast access.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * fgh 5/2/86 Added DontRecacheFlg arg)
(* * fgh 6/9/86 Added code to check to make sure other operations are not in progress. And DontCheckOpInProgressFlg
arg to match)
(* * fgh 6/26/86 Added InterestedWindow & OperationMsg arg.)
(* * rht 7/2/86: Now bails out if notefile is readonly, user confirms, but we're supposed to write down changes.)
(* * rht 7/13/86: Now takes QuietFlg arg.)
(* * rht 7/14/86: Call NC.DeactivateCard from here instead of in card type QuitFn. Take a Don'tDeactivateFlg as
well.)
(* * rht 10/7/86: Now removes DELETEME imageobj's from card substance.)
(* * rht 11/2/86: Now returns DON'T if operation in progress.)
(* * rht 11/13/86: Now closes open proplist editor if any before saving.)
(* * rg 3/4/87 rewritten to use new NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg arg)
(* * rht 3/24/87: Now calls NC.CoerceToInterestedWindow and passes InterestedWindow to NC.InsureProperFiling.)
(* * rht 4/24/87: Fixed a vmem leak: when CallCloseWFlg is nil it doesn't clear CardObject windowprop.)
(* * pmi 9/16/87: Undoes previous fix to this function. Needed to get NCLOGGER working. It depends on getting the
CardObject off of the Window passed in as CardIdentifier.)
(DECLARE (GLOBALVARS NC.RemoveDELETEMEImageObjsFromCardFlg))
(LET ((Card (NC.CoerceToCard CardIdentifier))
Window ReadOnlyCardFlg)
(NC.ProtectedCardOperation
Card "Close Card" InterestedWindow
(PROG NIL
(SETQ ReadOnlyCardFlg (NC.ReadOnlyCardP Card))
(* The window not being open should mean that it's
shrunken. If so, expand it.)
(SETQ Window (NC.FetchWindow Card))
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow
Card)))
(COND
((AND Window (NOT (OPENWP Window)))
(EXPANDW Window)))
(* * if proper filing says don't quit then get out)
[OR DontSaveFlg ReadOnlyCardFlg (COND
((EQ (NC.InsureProperFiling Card InterestedWindow)
(QUOTE DON'T))
(RETURN (QUOTE DON'T]
(* * If card is readonly but we've made changes that we're supposed to save, then get user confirmation and bail
out.)
(if [AND (NOT DontSaveFlg)
(NOT Don'tDeactivateFlg)
ReadOnlyCardFlg
(NC.CardSomehowDirtyP Card)
(NULL QuietFlg)
(NOT (PROGN (NC.PrintMsg InterestedWindow T
"Card has been changed, but notefile is readonly."
(CHARACTER 13))
(NC.AskYesOrNo
"Want to quit anyway, flushing changes? "
NIL
(QUOTE Yes)
NIL InterestedWindow]
then (RETURN (QUOTE DON'T)))
(* * Otherwise go ahead and quit)
(RETURN (PROGN (* Close open proplist editor if any.)
[AND Window (LET ((PropListEditorWindow (
NC.PropListEditorOpenP
Window)))
(AND PropListEditorWindow (CLOSEW
PropListEditorWindow]
(COND
((AND Window NC.CloseCardsOffScreenFlg)
[COND
((NOT (NC.FetchSavedRegion Card))
(NC.SetSavedRegion Card (WINDOWPROP Window
(QUOTE REGION]
(MOVEW Window 1500 1500)))
(OR DontSaveFlg (if ReadOnlyCardFlg
then (NC.TurnOffDirtyFlgs Card)
else
(AND
NC.RemoveDELETEMEImageObjsFromCardFlg
(
NC.RemoveDELETEMEImageObjsFromCard
Card
(FUNCTION NC.DELETEMEImageObjP))
)
(NC.CardSaveFn Card (OR
NC.CloseCardsOffScreenFlg
QuietFlg)
InterestedWindow
OperationMsg)))
(AND Window (WINDOWDELPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.QuitCard)))
(PROG1 (NC.ApplyFn QuitFn Card)
(* * (AND Window (WINDOWPROP Window (QUOTE NoteCardObject) NIL)))
(AND CallCloseWFlg Window (CLOSEW Window))
(OR Don'tDeactivateFlg (NC.DeactivateCard Card))
(* * if this is one of the top level cards, then make sure it stays cached)
(if (AND (NC.TopLevelCardP Card)
(NULL DontRecacheFlg)
(NULL Don'tDeactivateFlg))
then (NCP.ActivateCards Card])
(NC.MarkCardDirty
[LAMBDA (Card ResetFlg) (* fgh: " 6-Feb-86 22:03")
(* Mark card specified by ID as being DIRTY and
needing to be writtent to the database)
(* * rht 2/1/85: Now also sets/resets property on ID indicating substance dirty.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(NC.ApplyFn MarkDirtyFn Card ResetFlg)
(NC.SetSubstanceDirtyFlg Card (NOT ResetFlg])
(NC.FetchDefaultHeight
[LAMBDA (Card) (* fgh: " 5-Feb-86 13:43")
(* * Fetch default height corresponding to Card)
(* * fgh 2/5/86 First created.)
(fetch (Card DefaultHeight) of Card])
(NC.FetchDefaultWidth
[LAMBDA (Card) (* fgh: " 5-Feb-86 13:42")
(* * Fetch the default width corresponding to Card)
(* * fgh 2/5/86 First created.)
(fetch (Card DefaultWidth) of Card])
(NC.FetchLinkAnchorModesSupported
[LAMBDA (Card) (* fgh: " 5-Feb-86 13:45")
(* * Fetch the link anchor modes supported of Card)
(fetch (Card LinkAnchorModesSupported) of Card])
(NC.FetchLinkDisplayMode
[LAMBDA (Card) (* fgh: " 5-Feb-86 13:40")
(* * Fetch the default link display mode corresponding to Card)
(* * fgh 2/5/86 First created.)
(fetch (Card LinkDisplayMode) of Card])
(NC.FetchLinkIconAttachedBitMap
[LAMBDA (Card ScaledHeightToMatch Scale) (* rht: " 7-Aug-86 18:00")
(* * Return the default link icon attached bit map corresponding to Card)
(* * fgh 2/5/86 First created.)
(* * rht 5/10/86: Now takes special action if BitMapVal is a list. In that case, it should be an ordered prop list
of heights and bitmaps. We take the one closest in height to HeightToMatch.)
(* * rht 8/7/86: Now converts single bitmap to list of bitmaps of different heights if necessary.
Also now takes Scale argument.)
(LET ((BitMapVal (fetch (Card LinkIconAttachedBitMap) of Card)))
[if (BITMAPP BitMapVal)
then (replace (NoteCardType LinkIconAttachedBitMap) of (NC.CardTypeRecord
(NC.FetchType Card))
with (SETQ BitMapVal (NC.MakeTypeIconBitMapSet BitMapVal
NC.DefaultLinkIconAttachedBitMapHeights]
(if (LISTP BitMapVal)
then (OR ScaledHeightToMatch (SETQ ScaledHeightToMatch 0))
(OR Scale (SETQ Scale 1))
(LET (BitMap)
[for X on BitMapVal by (CDDR X)
do (LET [(ScaledHeight (TIMES Scale (CAR X]
(if (OR (NULL BitMap)
(LEQ ScaledHeight ScaledHeightToMatch))
then (SETQ BitMap (CADR X))
elseif (GREATERP ScaledHeight ScaledHeightToMatch)
then (RETURN]
BitMap])
(NC.InstallTitleBarMiddleMenu
[LAMBDA (Window CardType) (* pmi: " 1-Apr-87 16:47")
(* * Make a middle button title bar menu and install.)
(* * pmi 4/1/87: Added NC.MenuFont to all menus)
(DECLARE (GLOBALVARS NC.MenuFont))
(WINDOWPROP Window (QUOTE TitleBarMiddleButtonMenu)
(create MENU
ITEMS ← (NC.GetCardTypeField MiddleButtonMenuItems CardType)
CENTERFLG ← T
MENUFONT ← NC.MenuFont
ITEMHEIGHT ← (IPLUS (FONTPROP NC.MenuFont (QUOTE HEIGHT))
1])
)
(* * changes to NCREPAIR)
(DEFINEQ
(NC.CardSubstanceVersionInspector
[LAMBDA (Card SubstanceInfo) (* rht: "26-Mar-86 12:26")
(* * Fill in a SUBSTANCEDATA record and bring up an inspector on it.)
(* * rht 12/8/85: Modified to reflect new card and notefile object formats.)
(* * rht 3/22/86: Fixed to handle substance version nums. Now calls NC.ApplyFn and handles Hash card types.
Also changed the way text, graph, and sketch cards are handled.)
(LET ((NoteFile (fetch (Card NoteFile) of Card))
Stream Type WindowTitle Sketch SketchObjDatum Length SubstanceVersionNum ListMenu
TempStream StartLoc) (* Position file at main card data.
Hopefully no need to check validity of what we're
reading.)
(SETFILEPTR (SETQ Stream (fetch (NoteFile Stream) of NoteFile))
(CAR SubstanceInfo))
(NC.ReadCardPartHeader Card NC.ItemIdentifier)
[NC.SetType Card (SETQ Type (CAR (NC.RobustReadAtom Stream]
(NC.RobustReadRegion Stream (GETEOFPTR Stream))
(SETQ Length (NC.ReadPtr Stream 3))
(SETQ SubstanceVersionNum (NC.ReadPtr Stream 1))
(SETQ WindowTitle (CONCAT Type ": " (NC.ShaveTitleString (
NC.FetchTitleFromScavengerInfo
Card))
" | Date: "
(CADR SubstanceInfo)))
(* Unfortunately, can only inspect system-defined
substances now.)
(COND
((NC.IsSubTypeOfP Type (QUOTE Text)) (* This is so that user edits a copy of the text and
can't affect original.)
(COPYBYTES Stream (SETQ TempStream (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW)))
(SETQ StartLoc (GETFILEPTR Stream))
(PLUS StartLoc Length))
(OPENTEXTSTREAM (COPYTEXTSTREAM (OPENTEXTSTREAM TempStream)
T)
(CREATEW (PROGN (NC.PrintMsg NIL T
"Choose region for Text card display.")
(GETREGION))
WindowTitle)))
((NC.IsSubTypeOfP Type (QUOTE Graph))
(SHOWGRAPH (NC.MakeExternalGraphCopy (NC.ApplyFn GetFn Card Length Stream
SubstanceVersionNum))
(CREATEW (PROGN (NC.PrintMsg NIL T
"Choose region for Graph card display.")
(GETREGION))
WindowTitle)
NIL NIL NIL T))
((NC.IsSubTypeOfP Type (QUOTE Sketch))
(SETQ Sketch (NC.ApplyFn GetFn Card Length Stream SubstanceVersionNum))
(SKETCHW.CREATE (NC.ExternalizeLinkIconsInSketch Sketch)
(NC.FetchRegionViewed Card)
(PROGN (NC.PrintMsg NIL T "Choose region for Sketch card display.")
(GETREGION))
WindowTitle
(NC.FetchScale Card)))
((NC.IsSubTypeOfP Type (QUOTE List))
(SETQ ListMenu (create MENU
ITEMS ← (NC.ApplyFn GetFn Card Length Stream
SubstanceVersionNum)
TITLE ← WindowTitle))
(ADDMENU ListMenu NIL (GETBOXPOSITION (fetch (MENU IMAGEWIDTH) of ListMenu)
(fetch (MENU IMAGEHEIGHT) of ListMenu)
NIL NIL NIL
"Choose region for List card display.")))
((NC.IsSubTypeOfP Type (QUOTE Hash))
(WINDOWPROP (INSPECT (NC.ApplyFn GetFn Card Length Stream SubstanceVersionNum))
(QUOTE TITLE)
WindowTitle))
(T (NC.PrintMsg NIL T
"Sorry, can only inspect card types inheriting from Text, Graph, Sketch, List or Hash."])
(NC.RobustGetSubstance
[LAMBDA (Card Length Stream SubstanceVersion) (* rht: " 8-May-87 14:20")
(* * Try to get substance robustly. RESETVAR prevents breaks. Returns either substance or nil if unsuccessful.)
(* * rht 12/1/85: Updated to use card and notefile format.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * rht 3/22/86: Now passes substance version %#s and Stream to GetFn.)
(* * rht 5/8/87: Changed to use LET rather than RESETVAR to temporarily nullify HELPFLAG value.)
(LET ((HELPFLAG NIL))
(NLSETQ (NC.ApplyFn GetFn Card Length Stream SubstanceVersion])
)
(* * changes to NCTYPESMECH)
[DECLARE: EVAL@COMPILE
(DATATYPE NoteCardType (TypeName SuperType StubFlg FullDefinitionFile MakeFn (MakeFnInheritedFlg
FLAG)
EditFn
(EditFnInheritedFlg FLAG)
QuitFn
(QuitFnInheritedFlg FLAG)
MakeReadOnlyFn
(MakeReadOnlyFnInheritedFlg FLAG)
MakeReadWriteFn
(MakeReadWriteFnInheritedFlg FLAG)
GetFn
(GetFnInheritedFlg FLAG)
PutFn
(PutFnInheritedFlg FLAG)
CopyFn
(CopyFnInheritedFlg FLAG)
MarkDirtyFn
(MarkDirtyFnInheritedFlg FLAG)
DirtyPFn
(DirtyPFnInheritedFlg FLAG)
CollectLinksFn
(CollectLinksFnInheritedFlg FLAG)
DeleteLinksFn
(DeleteLinksFnInheritedFlg FLAG)
UpdateLinkIconsFn
(UpdateLinkIconsFnInheritedFlg FLAG)
InsertLinkFn
(InsertLinkFnInheritedFlg FLAG)
TranslateWindowPositionFn
(TranslateWindowPositionFnInheritedFlg FLAG)
LinkDisplayMode
(LinkDisplayModeInheritedFlg FLAG)
DefaultWidth
(DefaultWidthInheritedFlg FLAG)
DefaultHeight
(DefaultHeightInheritedFlg FLAG)
LinkAnchorModesSupported
(LinkAnchorModesSupportedInheritedFlg FLAG)
DisplayedInMenuFlg
(DisplayedInMenuFlgInheritedFlg FLAG)
LinkIconAttachedBitMap
(LinkIconAttachedBitMapInheritedFlg FLAG)
LeftButtonMenuItems
(LeftButtonMenuItemsInheritedFlg FLAG)
MiddleButtonMenuItems
(MiddleButtonMenuItemsInheritedFlg FLAG))
MakeFnInheritedFlg ← T EditFnInheritedFlg ← T QuitFnInheritedFlg ← T
MakeReadOnlyFnInheritedFlg ← T MakeReadWriteFnInheritedFlg ← T GetFnInheritedFlg ← T
PutFnInheritedFlg ← T CopyFnInheritedFlg ← T MarkDirtyFnInheritedFlg ← T
DirtyPFnInheritedFlg ← T CollectLinksFnInheritedFlg ← T DeleteLinksFnInheritedFlg ← T
UpdateLinkIconsFnInheritedFlg ← T InsertLinkFnInheritedFlg ← T
TranslateWindowPositionFnInheritedFlg ← T LinkDisplayModeInheritedFlg ← T
DefaultWidthInheritedFlg ← T DefaultWidthInheritedFlg ← T DefaultHeightInheritedFlg ← T
LinkAnchorModesSupportedInheritedFlg ← T LinkIconAttachedBitMapInheritedFlg ← T
LeftButtonMenuItemsInheritedFlg ← T MiddleButtonMenuItemsInheritedFlg ← T
DisplayedInMenuFlgInheritedFlg ← NIL MakeFn ← (QUOTE \\FILLME//)
EditFn ← (QUOTE \\FILLME//)
QuitFn ← (QUOTE \\FILLME//)
MakeReadOnlyFn ← (QUOTE \\FILLME//)
MakeReadWriteFn ← (QUOTE \\FILLME//)
GetFn ← (QUOTE \\FILLME//)
PutFn ← (QUOTE \\FILLME//)
CopyFn ← (QUOTE \\FILLME//)
MarkDirtyFn ← (QUOTE \\FILLME//)
DirtyPFn ← (QUOTE \\FILLME//)
CollectLinksFn ← (QUOTE \\FILLME//)
DeleteLinksFn ← (QUOTE \\FILLME//)
UpdateLinkIconsFn ← (QUOTE \\FILLME//)
InsertLinkFn ← (QUOTE \\FILLME//)
TranslateWindowPositionFn ← (QUOTE \\FILLME//)
LinkDisplayMode ← (QUOTE \\FILLME//)
DefaultWidth ← (QUOTE \\FILLME//)
DefaultHeight ← (QUOTE \\FILLME//)
LinkAnchorModesSupported ← (QUOTE \\FILLME//)
DisplayedInMenuFlg ← (QUOTE \\FILLME//)
LinkIconAttachedBitMap ← (QUOTE \\FILLME//)
LeftButtonMenuItems ← (QUOTE \\FILLME//)
MiddleButtonMenuItems ← (QUOTE \\FILLME//))
]
(/DECLAREDATATYPE (QUOTE NoteCardType)
(QUOTE (POINTER POINTER POINTER POINTER POINTER FLAG POINTER FLAG POINTER FLAG
POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG
POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG
POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG
POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG POINTER FLAG))
[QUOTE ((NoteCardType 0 POINTER)
(NoteCardType 2 POINTER)
(NoteCardType 4 POINTER)
(NoteCardType 6 POINTER)
(NoteCardType 8 POINTER)
(NoteCardType 8 (FLAGBITS . 0))
(NoteCardType 10 POINTER)
(NoteCardType 10 (FLAGBITS . 0))
(NoteCardType 12 POINTER)
(NoteCardType 12 (FLAGBITS . 0))
(NoteCardType 14 POINTER)
(NoteCardType 14 (FLAGBITS . 0))
(NoteCardType 16 POINTER)
(NoteCardType 16 (FLAGBITS . 0))
(NoteCardType 18 POINTER)
(NoteCardType 18 (FLAGBITS . 0))
(NoteCardType 20 POINTER)
(NoteCardType 20 (FLAGBITS . 0))
(NoteCardType 22 POINTER)
(NoteCardType 22 (FLAGBITS . 0))
(NoteCardType 24 POINTER)
(NoteCardType 24 (FLAGBITS . 0))
(NoteCardType 26 POINTER)
(NoteCardType 26 (FLAGBITS . 0))
(NoteCardType 28 POINTER)
(NoteCardType 28 (FLAGBITS . 0))
(NoteCardType 30 POINTER)
(NoteCardType 30 (FLAGBITS . 0))
(NoteCardType 32 POINTER)
(NoteCardType 32 (FLAGBITS . 0))
(NoteCardType 34 POINTER)
(NoteCardType 34 (FLAGBITS . 0))
(NoteCardType 36 POINTER)
(NoteCardType 36 (FLAGBITS . 0))
(NoteCardType 38 POINTER)
(NoteCardType 38 (FLAGBITS . 0))
(NoteCardType 40 POINTER)
(NoteCardType 40 (FLAGBITS . 0))
(NoteCardType 42 POINTER)
(NoteCardType 42 (FLAGBITS . 0))
(NoteCardType 44 POINTER)
(NoteCardType 44 (FLAGBITS . 0))
(NoteCardType 46 POINTER)
(NoteCardType 46 (FLAGBITS . 0))
(NoteCardType 48 POINTER)
(NoteCardType 48 (FLAGBITS . 0))
(NoteCardType 50 POINTER)
(NoteCardType 50 (FLAGBITS . 0))
(NoteCardType 52 POINTER)
(NoteCardType 52 (FLAGBITS . 0]
(QUOTE 54))
(DEFINEQ
(NC.IsSubTypeOfP
[LAMBDA (SubTypeName SupposedSuperTypeName) (* rht: "15-Jul-86 18:06")
(* * Is SubTypeName the name of a Card type that is a sub type of carrd type SupposedSuperTypeName.)
(LET (SuperType)
(OR (EQ SubTypeName SupposedSuperTypeName)
(AND (SETQ SuperType (NC.GetCardTypeField SuperType SubTypeName))
(NC.IsSubTypeOfP SuperType SupposedSuperTypeName])
(NC.ListOfCardTypes
[LAMBDA (ForMenuFlg) (* fgh: " 2-Sep-86 00:30")
(* * Return a list of the note card types)
(* * Special processing for older types to make them not all caps.)
(* * fgh 1/31/86 Updated to handle card type Hash array.)
(* * fgh 9/1/86 Updated to handle \\EMPTY// slots in CardType defns.)
(SORT (LET (CollectLst)
[MAPHASH NC.CardTypes (FUNCTION (LAMBDA (TypeRecord TypeName)
(if (OR (NULL ForMenuFlg)
(EQ (fetch (NoteCardType DisplayedInMenuFlg)
of TypeRecord)
T))
then (push CollectLst (fetch (NoteCardType TypeName)
of TypeRecord]
CollectLst])
(NC.RecomputeCardType
[LAMBDA (TypeName FnsAssocList VarsAssocList) (* Randy.Gobbel "27-Mar-87 17:05")
(* * Recomputes an existing card type, changing those fields present on FnsAssocList and VarsAssocList.)
(* * rg 3/27/87 added WITH.MONITOR)
(WITH.MONITOR NC.TypesLock (LET ((TypeRecord (NC.CardTypeRecord TypeName))
SuperType)
[COND
((NULL TypeRecord)
(NC.ReportError "NC.RecomputeCardType" (CONCAT
"Unknown type: "
TypeName)))
([AND (NEQ TypeName (QUOTE NoteCard))
(NULL (NC.CardTypeRecord (SETQ SuperType
(fetch (NoteCardType
SuperType)
of TypeRecord]
(NC.ReportError "NC.RecomputeCardType"
(CONCAT TypeName
" has unknown super type: "
SuperType]
(* * Compute fields, inheriting from above and propagating downward.)
(NC.ModifyCardType TypeRecord FnsAssocList VarsAssocList)
(* * reset the menu)
(SETQ NC.NoteCardTypeMenu)
TypeName])
(NC.PropagateCardTypeFieldsDownward
[LAMBDA (TypeNameOrRecord) (* rht: " 7-Nov-86 14:54")
(* * For all subtypes of TypeNameOrRecord, inherit fields from TypeNameOrRecord.)
(* * fgh 2/3/86 First created.)
(* * rht 11/7/86: Fixed minor typo.)
(for SubType in (NC.SubTypesOfCardType (if (type? NoteCardType TypeNameOrRecord)
then (fetch (NoteCardType TypeName)
of TypeNameOrRecord)
else TypeNameOrRecord))
do (NC.InheritFieldsFromSuperType SubType (if (type? NoteCardType TypeNameOrRecord)
then TypeNameOrRecord
else NIL))
(NC.PropagateCardTypeFieldsDownward SubType])
(NC.SubTypesOfCardType
[LAMBDA (TypeName) (* fgh: "31-Jan-86 21:49")
(* * Returns a list of the types names of all the sub-types of TypeName)
(* * fgh 1/31/86 First created.)
(LET (CollectLst)
[MAPHASH NC.CardTypes (FUNCTION (LAMBDA (TypeRecord Key)
(if (EQ TypeName (fetch (NoteCardType SuperType) of TypeRecord))
then (push CollectLst (fetch (NoteCardType TypeName) of
TypeRecord]
CollectLst])
(NC.InheritFieldsFromSuperType
[LAMBDA (TypeNameOrRecord SuperTypeRecord) (* rht: " 8-Nov-86 18:10")
(* * Inherit fields from super card type record if the supertype is not a stub.)
(* * fgh 2/3/86 First created.)
(* * fgh 8/26/86 Now uses SuperTypeRecord consistently if it is present.)
(* * rht 11/7/86: Changed procedure for deciding when to inherit a field from upstairs.)
(LET [(TypeRecord (if (type? NoteCardType TypeNameOrRecord)
then TypeNameOrRecord
else (NC.CardTypeRecord TypeNameOrRecord)))
(InheritedFlgNames (CONSTANT (for FieldName in (RECORDFIELDNAMES (QUOTE
NoteCardType))
when (EQ (QUOTE InheritedFlg)
(SUBATOM FieldName -12 -1))
collect FieldName]
(if [OR SuperTypeRecord (SETQ SuperTypeRecord (NC.CardTypeRecord
(fetch (NoteCardType SuperType) of TypeRecord]
then (for FlgName in InheritedFlgNames
do (LET ((FieldName (SUBATOM FlgName 1 -13))
FieldValue SuperFieldValue)
(SETQ FieldValue (RECORDACCESS (BQUOTE (NoteCardType ,
FieldName))
TypeRecord NIL (QUOTE fetch)))
(SETQ SuperFieldValue (RECORDACCESS (BQUOTE (NoteCardType
, FieldName))
SuperTypeRecord NIL
(QUOTE fetch)))
(* * Only inherit from the super field if it's got a real value, and if either the subfield has value \\FILLME// or
the InheritedFlg field says to inherit. Don't inherit if the subfield is \\EMPTY//, cause that indicates a field
for a stub that shouldn't inherit.)
(if [AND [NOT (FMEMB SuperFieldValue (QUOTE (\\FILLME//
\\EMPTY//]
(NOT (EQ FieldValue (QUOTE \\EMPTY//)))
(OR (EQ FieldValue (QUOTE \\FILLME//))
(RECORDACCESS (BQUOTE (NoteCardType , FlgName)
)
TypeRecord NIL (QUOTE fetch]
then (RECORDACCESS (BQUOTE (NoteCardType , FieldName))
TypeRecord NIL (QUOTE replace)
SuperFieldValue])
(NC.AutoLoadCardType
[LAMBDA (TypeName FieldName FileSuggestion) (* kirk: "22-Aug-86 15:48")
(* * AutoLoad card type TypeName using FileSuggestion as the first place to look. Otherwise look in the directories
specified by NoteCardsDirectories. Works by starting at the give Type and moving up the inheritance heirarchy
loading all types that are currently defined only by stubs until it reaches a card type for which FieldName is
defined. This works because full inheritance is done whereever possible during type definition in NC.AddCardType.)
(* * fgh 2/3/86 First created.)
(* * fgh 7/16/86 Added ALLOW.BUTTON.EVENTS call)
(* * kirk 8/22/86 Added check for NIL card type)
(ALLOW.BUTTON.EVENTS)
(LET ((CardTypeRecord (NC.CardTypeRecord TypeName))
(OriginalTypeName TypeName)
FieldValue)
(* * If there's no stub for this card type, load the type definition file.)
(if (NULL TypeName)
then (NC.ReportError NIL "NIL card type"))
[if (NULL CardTypeRecord)
then (NC.CardTypeLoader TypeName FileSuggestion)
(* * Still no definition then we're sunk.)
(if (NULL (SETQ CardTypeRecord (NC.CardTypeRecord TypeName)))
then (NC.ReportError NIL (CONCAT
"Cannot find definition of card type: "
TypeName]
(* * We have at least a stub for this card type. Move up the inheritance hierarchy loading the real files instead
of the stubs until we have a value of the field we are looking for.)
(until (EQ TypeName (QUOTE NoteCard))
do
(* * If this is a stub, load the real thing. Break if it can't be found.)
(if (fetch (NoteCardType StubFlg) of CardTypeRecord)
then (OR (NC.CardTypeLoader TypeName FileSuggestion)
(NC.ReportError NIL (CONCAT
"Cannot find full definition of card type: "
TypeName)))
(SETQ CardTypeRecord (NC.CardTypeRecord TypeName)))
(* * If the field was defined in the real thing, then return it. Else keep moving up load ing all the stubs.)
(if (SETQ FieldValue (RECORDACCESS (BQUOTE (NoteCardType , FieldName))
CardTypeRecord NIL (QUOTE fetch)))
then (RETURN FieldValue)
else (SETQ TypeName (fetch (NoteCardType SuperType) of CardTypeRecord))
(SETQ CardTypeRecord (NC.CardTypeRecord TypeName)))
finally (NC.ReportError NIL (CONCAT "Cannot find definition of card type: "
OriginalTypeName " Field name needed: "
FieldName])
(NC.MakeCardTypesList
[LAMBDA NIL (* Randy.Gobbel "28-Sep-87 16:56")
(* * Make initial set of card types.)
(* * fgh 1/31/86 Updated to handle hash table for card types.)
(* * fgh 2/17/86 Added typless attached bit map to NoteCards card type.)
(* * rht 4/7/86: Now sets up default left and middle button menu items.)
(* * rg 3/27/87 added WITH.MONITOR)
(DECLARE (GLOBALVARS NC.TypelessIcon NC.CardTypes NC.DefaultLeftButtonMenuItems
NC.DefaultMiddleButtonMenuItems NC.TypesLock NC.NoteCardTypeMenu))
(WITH.MONITOR NC.TypesLock (SETQ NC.CardTypes (OR (HARRAYP NC.CardTypes)
(HASHARRAY 50)))
(PUTHASH (QUOTE NoteCard)
(create NoteCardType
TypeName ← (QUOTE NoteCard)
SuperType ← NIL
CopyFn ← (FUNCTION [LAMBDA (Card ToStream FromStream Length)
(* Copy a card's substance using copybytes.)
(LET* ((FromStartPtr (GETFILEPTR FromStream))
(FromEndPtr (PLUS Length FromStartPtr)))
(COPYBYTES FromStream ToStream FromStartPtr
FromEndPtr)
T])
CollectLinksFn ← (FUNCTION NILL)
MakeReadOnlyFn ← (FUNCTION NILL)
MakeReadWriteFn ← (FUNCTION NILL)
LinkDisplayMode ← (create LINKDISPLAYMODE
ATTACHBITMAPFLG ← T)
DefaultWidth ← 100
DefaultHeight ← 100
LinkIconAttachedBitMap ← NC.TypelessIcon
LeftButtonMenuItems ← NC.DefaultLeftButtonMenuItems
MiddleButtonMenuItems ← NC.DefaultMiddleButtonMenuItems)
NC.CardTypes)
(SETQ NC.NoteCardTypeMenu])
(NC.AddCardType
[LAMBDA (TypeName SuperType FnsAssocList VarsAssocList FullDefinitionFile ListOfFILLMEFields
StubFlg) (* Randy.Gobbel "27-Mar-87 16:05")
(* * Create a new note card type and link it into the card type heirarchy.)
(* * fgh 1/31/86 Updated to handle card type hash table.)
(* * fgh 2/3/86 Updated to do inheritance at definition time rather than at access time.)
(* * rht 7/15/86: Innards replaced by call to NC.ModifyCardType.)
(* * rht 11/7/86: Now accepts ListOfFILLMEFields arg. Any such fields get the \\FILLME// atom as value.
No longer forces load of super. Takes three extra optional args StubFlg, FullDefinitionFile, and
ListOfFILLMEFields.)
(* * RG 3/27/87 added WITH.MONITOR)
(WITH.MONITOR NC.TypesLock
(LET [NewType (MainFieldNames (CONSTANT (for FieldName
in (RECORDFIELDNAMES (QUOTE
NoteCardType))
when (NEQ (QUOTE InheritedFlg)
(SUBATOM FieldName -12
-1))
collect FieldName]
(COND
((NULL TypeName)
(NC.ReportError "NC.AddCardType" "Illegal type name: NIL"))
((NULL SuperType)
(NC.ReportError "NC.AddCardType" "Illegal super type name: NIL")))
(* * Create new NoteCardType)
(SETQ NewType
(create NoteCardType
TypeName ← TypeName
SuperType ← SuperType
StubFlg ← StubFlg
FullDefinitionFile ← FullDefinitionFile))
(* * If it's a stub, then change the default values for fields from \\FILLME// to \\EMPTY// except for those in
ListOfFILLMEFields.)
[if StubFlg
then (for FieldName in MainFieldNames unless (FMEMB FieldName
ListOfFILLMEFields)
when (EQ (RECORDACCESS (BQUOTE (NoteCardType , FieldName)
)
NewType NIL (QUOTE fetch))
(QUOTE \\FILLME//))
do (RECORDACCESS (BQUOTE (NoteCardType , FieldName))
NewType NIL (QUOTE replace)
(QUOTE \\EMPTY//]
(* * Compute fields, inheriting from above and propagating downward.)
(NC.ModifyCardType NewType FnsAssocList VarsAssocList)
(* * Stash the new card type record, reset the menu and then return.)
(PUTHASH TypeName NewType NC.CardTypes)
(SETQ NC.NoteCardTypeMenu)
NewType])
(NC.CardTypeRecord
[LAMBDA (TypeName NewTypeRecord) (* kirk: "12-Feb-86 16:15")
(* * Retrieve the card type record for TypeName)
(* * fgh 1/31/86 Updated to handle hash table for card types. Also added code to allow modification of type record.
Does not do any consstency checking.)
(PROG1 (GETHASH TypeName NC.CardTypes)
(if NewTypeRecord
then (PUTHASH (fetch (NoteCardType TypeName) of NewTypeRecord)
NewTypeRecord NC.CardTypes])
(NC.ModifyCardType
[LAMBDA (TypeRecord FnsAssocList VarsAssocList) (* rht: "15-Jul-86 13:13")
(* * Changes the fields of the given type, inheriting other fields from the super and propagating changes downward.
This used to be the innards of NC.AddCardType.)
(if (type? NoteCardType TypeRecord)
then (LET [(MainFieldNames (CONSTANT (for FieldName in (RECORDFIELDNAMES
(QUOTE NoteCardType))
when (NEQ (QUOTE InheritedFlg)
(SUBATOM FieldName -12 -1))
collect FieldName]
(for AssocPair in (APPEND FnsAssocList VarsAssocList)
when (FMEMB (CAR AssocPair)
MainFieldNames)
do
(* * Set the proper field to the given value)
(RECORDACCESS (BQUOTE (NoteCardType , (CAR AssocPair)))
TypeRecord NIL (QUOTE replace)
(CADR AssocPair))
(* * Set the corresponding InheritedFlg to indicate that this field is not inherited.)
(RECORDACCESS [BQUOTE (NoteCardType , (PACK* (CAR AssocPair)
(QUOTE InheritedFlg]
TypeRecord NIL (QUOTE replace)
NIL)))
(* * Inherit any NIL fields from super type record.)
(AND (fetch (NoteCardType SuperType) of TypeRecord)
(NC.InheritFieldsFromSuperType TypeRecord))
(* * Propagate any changes downward to the subtypes of this type.)
(NC.PropagateCardTypeFieldsDownward TypeRecord])
)
(* * changes to NCPROGINT)
(DEFINEQ
(NCP.CardTypeSuper
[LAMBDA (Type) (* rht: " 2-Mar-87 21:59")
(* * Return the super type for this type.)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(if (NCP.CardTypeP Type)
then (NC.GetCardTypeField SuperType Type)
else (NCP.ReportError (QUOTE NCP.CardTypeSuper)
(CONCAT Type " is not a loaded NoteCard type."))
NIL])
(NCP.CardTypeLinkDisplayMode
[LAMBDA (Type) (* rht: " 2-Mar-87 21:59")
(* * Return the link display mode for this type.)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(if (NCP.CardTypeP Type)
then (NC.GetCardTypeField LinkDisplayMode Type)
else (NCP.ReportError (QUOTE NCP.CardTypeLinkDisplayMode)
(CONCAT Type " is not a loaded NoteCard type."))
NIL])
)
(* * changes to NCHASHCARD)
(DEFINEQ
(NC.RegistryCardMakeFn
[LAMBDA (Card Title NoDisplayFlg) (* rht: "26-Feb-86 11:09")
(* * Make a Registry substance.)
(NC.ApplySupersFn MakeFn Card Title NoDisplayFlg (LIST NC.DefaultRegistryCardHashArraySize])
)
(* * changes to NCTEXTCARD)
(DEFINEQ
(NC.InstallTextTitleBarMiddleMenu
[LAMBDA (Window CardType) (* pmi: " 2-Apr-87 10:23")
(* * Make a text card middle button title bar menu and install.)
(* * pmi 4/1/87: Changed to replace MENUFONT with NC.MenuFont)
(DECLARE (GLOBALVARS NC.MenuFont))
(LET (Menu)
[WINDOWPROP Window (QUOTE TitleBarMiddleButtonMenu)
(SETQ Menu (\TEDIT.CREATEMENU (NC.GetCardTypeField MiddleButtonMenuItems
CardType]
(replace (MENU MENUFONT) of Menu with NC.MenuFont)
(replace (MENU ITEMHEIGHT) of Menu with (IPLUS (FONTPROP NC.MenuFont
(QUOTE HEIGHT))
1))
(replace (MENU IMAGE) of Menu with NIL])
)
(* * changes to NCSKETCHCARD)
(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])
)
(* * changes to NCFILEBOXCARD)
(DEFINEQ
(NC.MakeFileBox
[LAMBDA (Card Title NoDisplayFlg ParamList) (* rht: "10-Nov-86 22:49")
(* Make up a blank contents card, hook it to the user
specified parent contents cards, and display it.)
(* * rht 12/2/84: In NoDisplayFlg case, changed to return ID rather than TextStream.)
(* * rht 12/8/84: Massive shaving. Took out code to force filing now (at creation time))
(* * rht 9/11/85: Took out insertion of spacer when no markers.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * fgh 2/6/86 Chaged calls to NC.FetchDefaultHeight & NC.FetchDefaultWidth)
(* * fgh 2/6/86 Removed bug where NC.ClearMsg was deleteing card immediately.)
(* * rht 4/11/86: Now passes Type and Window to NC.MakeTEditLeftMenu.)
(* * rht 8/2/86: Now lets NC.MakeTEditPropsList build the props to be passed to TEDIT.)
(* * rht 9/8/86: Now doesn't create window before calling TEDIT to avoid stupid prompt win popping up.)
(* * rht 9/19/86: Now applies supertype's MakeFn to cut out redundant code.)
(* * rht 11/10/86: Now passes NIL as title to Super's makefn.)
(DECLARE (GLOBALVARS NC.MarkersInFileBoxesFlg NC.SubBoxMarkerLabel NC.FiledCardMarkerLabel
NC.AlphabetizedFileBoxChildrenFlg))
(LET ((Spacer (CONCAT (CHARACTER 13)
(CHARACTER 13)))
Window TextStream Type)
[SETQ Window (WINDOWP (NC.ApplySupersFn MakeFn Card NIL NoDisplayFlg
(if ParamList
then (LISTPUT ParamList (QUOTE
Don'tAttachUserSpecifiedPropsFlg)
T)
else (QUOTE (
Don'tAttachUserSpecifiedPropsFlg T]
(SETQ TextStream (NC.FetchSubstance Card))
(COND
(NC.MarkersInFileBoxesFlg (TEDIT.INSERT.OBJECT (NC.MakePlaceMarker
NC.SubBoxMarkerLabel)
TextStream 1)
(TEDIT.INSERT TextStream Spacer 2)
(TEDIT.INSERT.OBJECT (NC.MakePlaceMarker
NC.FiledCardMarkerLabel)
TextStream 4)
(TEDIT.INSERT TextStream Spacer 5)))
(if NC.AlphabetizedFileBoxChildrenFlg
then (NCP.CardProp Card (QUOTE OrderingFn)
(FUNCTION NC.IDAlphOrder)))
(if NoDisplayFlg
then Card
else Window])
(NC.AddFileBoxCard
[LAMBDA NIL (* rht: " 7-Apr-86 18:21")
(* * fgh 2/17/86 Added attached bitmap field.)
(NC.AddCardType (QUOTE FileBox)
(QUOTE Text)
[BQUOTE ((MakeFn , (FUNCTION NC.MakeFileBox]
(BQUOTE ((LinkDisplayMode Title)
(DefaultHeight 200)
(DefaultWidth 335)
(DisplayedInMenuFlg , T)
(LinkIconAttachedBitMap , NC.FileBoxIcon)
(LeftButtonMenuItems
,
(for Item in (NC.GetCardTypeField LeftButtonMenuItems
(QUOTE Text))
join (if (EQ (CAR Item)
(QUOTE Insert% Link))
then (LIST NC.GlobalInsertLinkMenuItem
(QUOTE
(Put% Cards% Here
(FUNCTION
NC.FileBoxCollectChildren)
"Collect new cards and file boxes into this FileBox.")))
else (LIST Item])
)
(* * changes to NCBROWSERCARD)
(DEFINEQ
(NC.BringUpBrowserCard
[LAMBDA (Card Substance Region/Position) (* rht: " 6-Feb-87 15:57")
(* * Given a browser Substance, open a browser window and set it up to be a NoteCard with ID.)
(* * rht 11/17/84: Now returns window.)
(* * rht 9/11/85: Now checks for changed link icon display global params.)
(* * rht 11/17/85: Now handles new card and Notefile objects.)
(* * rht 2/1/86: Now restores any saved UID user data info stashed on card's prop list.)
(* * fgh 2/5/86 Added call to NC.ApplySupersFn)
(* * rht 2/14/86: Now rebuilds browser hash array.)
(* * rht 2/28/86: Added WINDOWPROP for SCROLLFN and RESHAPEFN.)
(* * rht 3/2/86: Took out call to NC.FetchBrowserHashArray.)
(* * rht 4/5/86: Now only replaces graphnodes' TONODES' NODEID and DESTNODEID if they're non-nil.)
(* * rht 5/5/86: Took out call to NC.SetupTitleBarMenu.)
(* * rht&pmi 2/6/87: Moved call to NC.GraphLinkIconUpdateCheck in front of call to GraphCard's EditFn so as to
remove "double display" problem.)
(LET ((GraphNodes (fetch (GRAPH GRAPHNODES) of Substance))
Window OldUIDToNewUIDHashArray BrowserSavedLinkingInfo)
(* * Restore any saved UID user data info stashed on card UID's prop list.)
[if (SETQ BrowserSavedLinkingInfo (NC.FetchBrowserSavedLinkingInfo Card))
then (SETQ OldUIDToNewUIDHashArray (HASHARRAY 100 NIL (FUNCTION NC.MakeHashKey)
(FUNCTION NC.SameUIDP)))
(for BrowserSavedLinkingInfoForNode in BrowserSavedLinkingInfo
eachtime (BLOCK) bind SourceUID when (SETQ SourceUID
(
NC.NewBrowserNodeUIDFromOldUID
(CAR
BrowserSavedLinkingInfoForNode)
GraphNodes
OldUIDToNewUIDHashArray))
do (for SavedLinkingInfo on (CDR BrowserSavedLinkingInfoForNode)
by (CDDR SavedLinkingInfo) eachtime (BLOCK)
do (NC.GraphNodeIDPutProp SourceUID (
NC.NewBrowserNodeUIDFromOldUID
(CAR SavedLinkingInfo)
GraphNodes OldUIDToNewUIDHashArray)
(CADR SavedLinkingInfo]
(NC.SetBrowserSavedLinkingInfo Card NIL)
(* * For each graph node corresponding to a notecard, hang the card object off the node id's prop list.)
[for GraphNode in GraphNodes bind LinkIcon DestCard eachtime (BLOCK)
when (NC.LinkIconImageObjP (SETQ LinkIcon (fetch (GRAPHNODE NODELABEL)
of GraphNode)))
do (NC.GraphNodeIDPutProp (NC.CoerceToGraphNodeID GraphNode)
(QUOTE CardObject)
(SETQ DestCard (fetch (Link DestinationCard)
of (NC.FetchLinkFromLinkIcon
LinkIcon]
(* * Make a new browser hash array with the new graph node UIDs.)
(NC.SetUserDataProp Card (QUOTE BrowserHashArray)
NIL)
(NC.GetBrowserHashArray Card Substance)
(* * For each graph node, fix the NODEID and DESTNODEID fields of each of its TONODES LinkParameters.)
[for GraphNode in GraphNodes eachtime (BLOCK)
do (for ToNode in (fetch (GRAPHNODE TONODES) of GraphNode)
bind (ThisNodeID ← (NC.CoerceToGraphNodeID GraphNode)) eachtime (BLOCK)
when (EQ (CAR ToNode)
LINKPARAMS)
do (AND (LISTGET ToNode (QUOTE NODEID))
(LISTPUT ToNode (QUOTE NODEID)
ThisNodeID))
(AND (LISTGET ToNode (QUOTE DESTNODEID))
(LISTPUT ToNode (QUOTE DESTNODEID)
(NC.CoerceToGraphNodeID (CADR ToNode]
(* * Bring up card and mess with its window.)
(NC.GraphLinkIconUpdateCheck Card NIL Substance T)
(SETQ Window (NC.ApplySupersFn EditFn Card Substance Region/Position))
(NC.MakeLinksLegendMenu Window (NC.FetchBrowserLinksLegend Card))
(* Disable the old-style right button grapher editor
menu.)
(WINDOWPROP Window (QUOTE RIGHTBUTTONFN)
(FUNCTION NC.BrowserRightButtonFn))
(WINDOWADDPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.GraphCardShrinkFn))
(WINDOWADDPROP Window (QUOTE REPAINTFN)
(FUNCTION NC.BrowserRepaintFn)
T)
(WINDOWPROP Window (QUOTE SCROLLFN)
(FUNCTION NC.BrowserScrollFn))
(WINDOWPROP Window (QUOTE RESHAPEFN)
(FUNCTION NC.BrowserReshapeFn))
(* * I have to hang notecard's Card on window now in case REDISPLAYW runs and tries to get Card from window.)
(WINDOWPROP Window (QUOTE NoteCardObject)
Card) (* Check if link icon display global params have
changed since last time card was up.
If so, fix graph nodes and redisplay.)
(* if (NC.GraphLinkIconUpdateCheck Card Window
Substance T) then (REDISPLAYW Window))
Window])
(NC.BrowserCardQuitFn
[LAMBDA (Card) (* rht: "25-Apr-87 17:57")
(* * This clears all UserData fields of Graph node UIDs. I ONLY HAVE TO DO THIS BECAUSE INTERLISP WON'T GC CYCLES!)
[for GraphNode in (fetch (GRAPH GRAPHNODES) of (NC.FetchSubstance Card))
do (LET ((GraphNodeID (NC.CoerceToGraphNodeIDOrLabel GraphNode)))
(AND (type? UID GraphNodeID)
(NC.UIDSetPropList GraphNodeID NIL]
(NCP.ApplySuperTypeFn QuitFn Card])
(NC.AddBrowserCard
[LAMBDA NIL (* rht: "25-Apr-87 17:58")
(* * fgh 11/14/85 Updated to handle merge of card and substance types.)
(* * rht 4/7/86: Added middle button menu items.)
(* * rht 4/25/87: Added QuitFn)
(NC.AddCardType (QUOTE Browser)
(QUOTE Graph)
[BQUOTE ((MakeFn , (FUNCTION NC.MakeBrowserCard))
(EditFn , (FUNCTION NC.BringUpBrowserCard))
(PutFn , (FUNCTION NC.PutBrowserSubstance))
(GetFn , (FUNCTION NC.GetBrowserSubstance))
(DeleteLinksFn , (FUNCTION NC.DelReferencesToCardFromBrowser))
(QuitFn , (FUNCTION NC.BrowserCardQuitFn]
(BQUOTE ((LinkDisplayMode Title)
(DefaultHeight 350)
(DefaultWidth 500)
(DisplayedInMenuFlg , T)
(LeftButtonMenuItems , (for Item in (NC.GetCardTypeField
LeftButtonMenuItems
(QUOTE Graph))
collect (if (EQ (CAR Item)
(QUOTE
Insert% Link))
then
NC.GlobalInsertLinkMenuItem
else Item)))
(MiddleButtonMenuItems , (QUOTE ((Recompute% Browser
(FUNCTION
NC.UpdateBrowserCard)
"Recomputes this browser to show the current state of the NoteFile.")
(Relayout% Graph
(FUNCTION
NC.RelayoutBrowserCard)
"Re-layout the browser, but keep same nodes.")
(Reconnect% Nodes
(FUNCTION
NC.ConnectNodesInBrowser)
"Draw all possible links, from currently selected link types, between pairs of nodes.")
(Unconnect% Nodes
(FUNCTION
NC.UnconnectNodesInBrowser)
"Undraw all links in the browser.")
(Expand% Browser% Node
(FUNCTION
NC.ExpandBrowserNode)
"Expand the graph under one node to a given depth.")
(Graph% Edit% Menu
(FUNCTION
NC.GetGraphEditMenu)
"Bring up the graph editor menu.")
(Change% Browser% Specs
(FUNCTION
NC.ChangeBrowserSpecs)
"Make changes to some or all of the browser specs, e.g. link types, depth, etc.")
(Browser% Overview% Win
(FUNCTION
NC.MakeBrowserOverviewWin)
"Attach the browser overview window.")
(Change% Overview% Specs
(FUNCTION
NC.AskBrowserOverviewSpecs)
"Change the browser overview specs: where to attach and what mode."])
)
(* * changes to NCSEARCHCARD)
(DEFINEQ
(NC.MakeSearchCard
[LAMBDA (Card Title NoDisplayFlg) (* rht: "25-Mar-87 17:11")
(* Search for cards with specified characteristics and create a list card containing pointers to these cards.
For now search is limited to cards whose title contains a specified string.)
(* * rht 11/8/84: Fixed some confusion between ListCardID and ID variables.)
(* * fgh 11/17/85 Updated to handle multiple notefiles and crad objects.)
(* * rht 4/11/86: changed to call NC.ApplySuper.)
(* * rht 10/21/86: Now deletes card if no search string specified.)
(* * rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard)
(LET ((NoteFile (fetch (Card NoteFile) of Card))
SearchString HitCards WindowOrCard Window)
(SPAWN.MOUSE)
(SETQ WindowOrCard (NC.ApplySupersFn MakeFn Card (OR Title "SearchCard")
NoDisplayFlg))
(NC.ActivateCard Card)
(SETQ Window (AND (WINDOWP WindowOrCard)
WindowOrCard))
(SETQ SearchString (NC.AskUser "Please enter the search string: " NIL NIL T Window))
(if (OR (EQUAL SearchString "")
(NOT SearchString))
then (NC.DeleteNoteCard Card NIL T)
NIL
else [NC.SetTitle Card (SETQ Title (OR Title (CONCAT "Cards with %""
SearchString "%" in title"]
(AND Window (WINDOWPROP Window (QUOTE TITLE)
Title))
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(NC.PrintMsg Window T "Searching for cards ...")
(SETQ HitCards (NC.TitleSearch NoteFile SearchString))
(TEDIT.INSERT (NC.FetchSubstance Card)
(CONCAT " List compiled on: " (DATE)
(CHARACTER 13)
(CHARACTER 13))
1)
(for HitCard in HitCards unless (EQ HitCard Card)
do (NC.InsertLinkBeforeMarker Card HitCard
NC.ListContentsLinkLabel NIL NIL))
(NC.PrintMsg Window NIL "Done!" (CHARACTER 13)))
(BLOCK 250)
(NC.ClearMsg Window T)
WindowOrCard])
)
(* * changes to NCDOCUMENTCARD)
(DEFINEQ
(NC.MakeDocument
[LAMBDA (Card Title NoDisplayFlg CardIdentifier) (* rht: " 4-Jun-87 12:14")
(* * Called from a filebox's title bar. Makes a document by smashing all the descendant cards's text together.
Ask user if wants numbered section headings and titles. The former are made from FileBox titles, the latter from
notecard titles. Delete embedded links at the end if the user desires.)
(* * rht 10/22/84: Hacked to be callable from Programmer's interface.)
(* * rht 11/17/84: Checks for cancel when choosing rootID and also when setting parameters.)
(* * rht 8/25/85: Now dumps sketch and graph cards as well as text cards.)
(* * rht 9/16/85: Now handles cr's around titles using para leading.)
(* * fgh 11/178/85 Updated to handle Card and NoteFile objects.)
(* * kirk 27Jun86 Moved NC.RetrieveTitle call so does not break when user Cancels)
(* * rht 7/31/86: Now checks for card types having ExportSubstanceFn prop.)
(* * kirk 8/22/86 Fix of free use of NoteFile var)
(* * rht 10/15/86: Integrated markM's changes and fixed box numbering.)
(* * rht 11/17/86: Now calls NC.ApplySupersFn rather than NC.MakeNoteCard.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper. Still needs ProtectedCardOperation wrapper!)
(* * rg 4/2/87 changed NC.CardSelectionOperation to NCP.WithLockedCards)
(* * rht 4/17/87: No longer bugs user for confirm of delete when cancel'ing.)
(* * rht 6/4/87: Now stashes on doc card a prop list of destination notefiles of cross-file links encountered
during creation of contents.)
(NCP.WithLockedCards (PROG (RootCard RootTitle DocWindow DocCard DocWindowOrCard DocStream
HeadingsFromFileboxes TitlesFromNoteCards BuildBackLinks
CopyEmbeddedLinks ExpandEmbeddedLinks InspectWin
RootSubstanceType)
(OR NoDisplayFlg (SPAWN.MOUSE))
(SETQ DocWindowOrCard (NC.ApplySupersFn MakeFn Card "Document"
NoDisplayFlg))
(if NoDisplayFlg
then (SETQ DocWindow NIL)
(SETQ DocCard DocWindowOrCard)
else (SETQ DocWindow DocWindowOrCard)
(SETQ DocCard (NC.CoerceToCard DocWindow)))
(* NC.MakeNoteCard either returned an Card or a window
depending on NoDisplayFlg.)
(SETQ RootCard (OR (NC.CoerceToCard CardIdentifier)
(NC.SelectNoteCards T NIL
NC.SelectingCardMenu
DocWindow
"Please shift-select the Note Card or File Box the document should start from.")))
(if (NOT RootCard)
then (NC.DeleteNoteCard Card NIL T)
(RETURN NIL))
(SETQ RootTitle (NC.RetrieveTitle RootCard))
(NC.SetTitle DocCard (CONCAT "Document from %"" RootTitle "%""))
(AND DocWindow (WINDOWPROP DocWindow (QUOTE TITLE)
(NC.RetrieveTitle DocCard)))
(SETQ DocStream (NC.FetchSubstance DocCard))
(* * Get MakeDocument parameters from user via inspector window.)
(if (NOT NoDisplayFlg)
then (SETQ InspectWin (NC.BuildMakeDocInspector DocWindow))
(TOTOPW InspectWin)
(for while (OPENWP InspectWin) do (BLOCK)))
(if (EQ (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE --DONE--))
(QUOTE QUIT))
then (PUTPROP (QUOTE NC.MakeDocParameters)
(QUOTE --DONE--)
(QUOTE --CANCEL--))
(NC.DeleteNoteCard Card NIL T)
(RETURN NIL))
(SETQ HeadingsFromFileboxes (GETPROP (QUOTE
NC.MakeDocParameters)
(QUOTE
HeadingsFromFileboxes)))
(SETQ TitlesFromNoteCards (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE TitlesFromNoteCards))
)
(SETQ BuildBackLinks (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE BuildBackLinks)))
(SETQ CopyEmbeddedLinks (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE CopyEmbeddedLinks)))
(SETQ ExpandEmbeddedLinks (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE ExpandEmbeddedLinks))
)
(* * Call recursive routine to dump filebox.)
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(NC.PrintMsg DocWindow NIL
"Collecting text from descendant cards ... ")
(* * Clean up the SeenBefore markers placed on the cards and boxes just copied.)
[RESETSAVE NIL
(QUOTE (PROGN
(for Card
in (NC.FetchUserDataProp
DocCard
(QUOTE SeenCards))
do (NC.SetUserDataProp
Card
(QUOTE SeenBefore)
NIL))
(NC.SetUserDataProp
DocCard
(QUOTE SeenCards)
NIL]
(* Clean up the CrossFileLinkModePropList hung off the
Doccard.)
[RESETSAVE NIL (QUOTE (PROGN (NC.SetUserDataProp
DocCard
(QUOTE
CrossFileLinkModePropList)
NIL]
(* * Unbelievably kludgy hack to get around Intermezzo TEdit bug. Just insert and delete a CR.)
(TEDIT.INSERT DocStream NC.CRString 1)
(TEDIT.DELETE DocStream 1 1)
(NC.SetUserDataProp DocCard (QUOTE
CrossFileLinkModePropList)
(LIST (fetch (Card NoteFile)
of DocCard)
NIL))
(NC.DumpCardToDoc RootCard DocCard DocStream 0 0
HeadingsFromFileboxes
TitlesFromNoteCards BuildBackLinks
CopyEmbeddedLinks
ExpandEmbeddedLinks)
(NC.PrintMsg DocWindow NIL "Done!"))
(COND
((NOT NoDisplayFlg)
(BLOCK 250)
(NC.ClearMsg DocWindow T)))
(RETURN DocWindowOrCard])
)
(* * changes to NCLINKINDEXCARD)
(DEFINEQ
(NC.MakeLinkIndex
[LAMBDA (Card Title NoDisplayFlg SpecialArgsList) (* rht: "17-Apr-87 20:01")
(* * Gather all instances of a given set of linktypes, printing the titles of cards at the from and to ends of the
link.)
(* * rht 10/24/84: Now callable from Programmer's interface. If NoDisplayFlg it non-nil, then will build LinkIndex
invisibly. If SpecialArgsList is non-nil, then should be list of (<linklabels> <backpointersP>))
(* * rht 9/21/85: Now uses stylesheet for LinkIndexSpecs. Broke out workhorse code into the function
NC.ComputeLinkIndex)
(* * fgh 11/17/85 Updated to handle Card objects.)
(* * rht 4/11/86: Took out call to NCP.AddTitleBarMenuItems. Now done in NC.AddLinkIndexCard.
Also changed to call NC.ApplySuper.)
(* * rht 9/5/86: Now bails out properly if user aborts in stylesheet.)
(* * rht 9/19/86: Now passes IndexCard rather than Window to NC.AskLinkIndexSpecs. Added call to NC.HoldTTYProcess
to keep linkindexspecs on top.)
(* * rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard)
(PROG ((LinkLabels (CAR SpecialArgsList))
(BackLinksFlg (CADR SpecialArgsList))
Window LinkIndexSpecs)
(SPAWN.MOUSE)
(SETQ Window (WINDOWP (NC.ApplySupersFn MakeFn Card (CONCAT "Link Index: "
(DATE))
NoDisplayFlg)))
(if (NOT NoDisplayFlg)
then (NC.HoldTTYProcess)
(SETQ LinkIndexSpecs (NC.AskLinkIndexSpecs Card LinkLabels BackLinksFlg T))
(if (NULL LinkIndexSpecs)
then (NC.DeleteNoteCard Card NIL T)
(RETURN NIL))
(SETQ LinkLabels (CAR LinkIndexSpecs))
(SETQ BackLinksFlg (CADR LinkIndexSpecs)))
(NC.ComputeLinkIndex Card LinkLabels BackLinksFlg)
(RETURN (if NoDisplayFlg
then Card
else (NC.ClearMsg Window T)
Window])
(NC.AddLinkIndexCard
[LAMBDA NIL (* rht: "11-Apr-86 21:58")
(* * fgh 11/14/85 Updated toremove substance type param to add card type.)
(NC.AddCardType (QUOTE LinkIndex)
(QUOTE Text)
[BQUOTE ((MakeFn , (FUNCTION NC.MakeLinkIndex))
(EditFn , (FUNCTION NC.BringUpLinkIndexCard]
(BQUOTE ((LinkDisplayMode Title)
(DefaultHeight 350)
(DefaultWidth 350)
(DisplayedInMenuFlg , T)
(LeftButtonMenuItems , (APPEND (NC.GetCardTypeField
LeftButtonMenuItems
(QUOTE
Text))
NC.LinkIndexExtraMenuItems])
)
(* * changes to NCLINKS)
(DEFINEQ
(NC.DelReferencesToCard
[LAMBDA (SourceCard LinkOrDestinationCard Don'tCreateDeletedImageObjFlg)
(* rht: " 9-Jun-87 18:16")
(* The card specified by DestinationID is being
deleted. Remove all references to it from the card
specified by SourceCard)
(* * kirk: 13Nov85: deleted use of DatabaseStream)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * kef 7/31/86: Added wrapping of write lock grabbing so that deactivating the card preserves the nesting of
write lock ownership.)
(* * kef 8/5/86: Added putting of Main Card data in ActiveP case. This is so that if subsequent other people bring
up the card, they will see the fact that link card was deleted.)
(* * kef 8/7/86: Now requires that the card is being edited rather than just Active to thwart direct write through
to NoteFile.)
(* * rht 8/11/86 Added ShrunkenFlg so that SourceCard is reshrunk afterwards if necessary.)
(* * fgh 8/30/86 Changed APPLY* to NC.ApplyFn. Appears there might be trouble here since we don't appear to wait if
we can't get all the write permission locks. I am assuming for now that this is being taken care of at a higher
level.)
(* * rht 9/19/86: It was testing NC.BeingEditedP to decide whether had to obtain write permission, etc. I think
NC.ActiveCardP is enough. NC.BeingEditedP is bogus anyway as it doesn't work on card's whose editors don't have
processes like graph cards.)
(* * rht 11/4/86: Now takes Don'tCreateDeletedImageObjFlg arg.)
(* * rht 3/19/87: Undo Ken's server-related fix of 8/5/86, i.e. ripped out call to NC.PutMainCardData when card is
active.)
(* * rht 6/9/87: Now marks card dirty after calling DeleteLinksFn.)
(LET ((ShrunkenFlg (NC.GetShrunkenWin SourceCard))
NoteCardType Substance)
[COND
((NC.ActiveCardP SourceCard)
(SETQ NoteCardType (NC.RetrieveType SourceCard))
(SETQ Substance (NC.FetchSubstance SourceCard))
(NC.ApplyFn DeleteLinksFn SourceCard LinkOrDestinationCard Don'tCreateDeletedImageObjFlg)
(NC.MarkCardDirty SourceCard))
(T (WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of SourceCard))
(if (NC.ValidCardP (NC.GetNoteCard SourceCard))
then (RESETLST (RESETSAVE (for CardPart
in (QUOTE (SUBSTANCE TOLINKS
GLOBALTOLINKS
PROPLIST))
do (NC.ApplyFn
ObtainWritePermissionFn
SourceCard
CardPart))
(BQUOTE (NC.DeactivateCard ,
SourceCard)))
(SETQ NoteCardType (NC.RetrieveType SourceCard)
)
(SETQ Substance (NC.FetchSubstance SourceCard))
(NC.ApplyFn DeleteLinksFn SourceCard
LinkOrDestinationCard
Don'tCreateDeletedImageObjFlg)
(NC.PutMainCardData SourceCard]
(NC.DelReferencesToCardFromGlobalList SourceCard LinkOrDestinationCard)
(AND ShrunkenFlg (SHRINKW (NC.FetchWindow SourceCard])
(NC.FetchLinkIconForLink
[LAMBDA (Link) (* fgh: " 5-Feb-86 19:52")
(* * Find the Link Icon corresponding to Link)
(* * kirk 14Nov85: deleted use of LinkID and PSA.Database)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(LET ((SourceCard (fetch (Link SourceCard) of Link)))
(for LinkIcon in (CAR (NC.ApplyFn CollectLinksFn SourceCard NIL T))
thereis (if (NC.SameLinkP Link (NC.FetchLinkFromLinkIcon LinkIcon))
then LinkIcon])
(NC.UpdateLinkImages
[LAMBDA (SourceWindowOrCard DestinationCard) (* fgh: " 5-Feb-86 20:01")
(* * Update the Link Image Objects in SourceCard that point to DestinationID)
(* * rht 10/2/85: Now checks if card's window was shrunk. If so, unshrink, modify and reshrink.)
(* * fgh 11/17/85 Updated to handle card objects.)
(* * fgh 2/5/86 Addeed call to NC.ApplyFn)
(LET (SourceWindow SourceCard NoteCardType ShrunkenWin)
(COND
((WINDOWP SourceWindowOrCard)
(SETQ SourceWindow SourceWindowOrCard)
(SETQ SourceCard (NC.CoerceToCard SourceWindowOrCard)))
(T (SETQ SourceWindow (NC.FetchWindow SourceWindowOrCard))
(SETQ SourceCard SourceWindowOrCard)))
(COND
((SETQ ShrunkenWin (NC.GetShrunkenWin SourceWindow))
(EXPANDW ShrunkenWin)))
(SETQ NoteCardType (NC.RetrieveType SourceCard))
(NC.ApplyFn UpdateLinkIconsFn SourceCard DestinationCard)
(COND
(ShrunkenWin (SHRINKW SourceWindow)))
NIL])
)
(* * changes to NCINTERFACE)
(DEFINEQ
(NC.InstallTitleBarLeftMenu
[LAMBDA (Window CardType) (* pmi: "25-Mar-87 12:04")
(* * Make a menu from the CardType's LeftButtonMenuItems and install on windowprop.)
(* * pmi 3/25/87: Added NC.MenuFont to all menus)
(DECLARE (GLOBALVARS NC.MenuFont))
(WINDOWPROP Window (QUOTE TitleBarLeftButtonMenu)
(create MENU
ITEMS ← (NC.GetCardTypeField LeftButtonMenuItems CardType)
CENTERFLG ← T
MENUFONT ← NC.MenuFont
ITEMHEIGHT ← (IPLUS (FONTPROP NC.MenuFont (QUOTE HEIGHT))
1])
)
(* * changes to NOTECARDS)
(DEFINEQ
(NC.PostGreet
[LAMBDA NIL (* Randy.Gobbel " 2-Sep-87 14:03")
(* * called when loading NOTECARDS and after each greet (for NOTECARDS sysout users) Note this means you cannot put
anything in here that should not be called twice!)
(* * kirk 10Jul86 added load of NCPOSTRELEASEPATCHES)
(* * kirk 10Aug86 set quietflg in call on NC.CardTypeLoader)
(* * fgh 8/27/86 Changed call to NC.AddCardTypeStub to NC.CardTypeStubLoader to go along with changes to
AddCardTypeStub)
(* * rg 10/29/86 Added calls to NC.FixFileDates after all LOAD calls)
(* * rg 12/11/86 Changed LOADFROM of source to LOADVARS of coms)
(* * RG 3/20/87 moved load of POSTRELEASEPATCHES after load of default card types)
(* * rg 4/24/87 added load of LISPUSERS packages using NC.LoadFileFromDirectories ; also moved call to
START-TEDIT-KILLER here)
(* * rg 7/10/87 zapped lotsa cruft about file loading, in conjunction with complete rework of all that stuff)
(* * rg 9/2/87 added (NC.FixFileDates NC.LoadedFiles))
(DECLARE (GLOBALVARS NC.CardTypes NC.CoreFiles NC.LoadedFiles NOTECARDTYPES NOTECARDTYPESTUBS
NOTECARDSLIBRARYFILES NOTECARDSLISPUSERSFILES NCINITIALGLOBALPARAMS))
[LET (FullFileName TypeName Type File)
(NC.FixFileDates NC.LoadedFiles)
(for TypeName in NOTECARDTYPES unless (AND (SETQ Type (GETHASH TypeName
NC.CardTypes))
(NOT (fetch (NoteCardType StubFlg)
of Type)))
do (NC.CardTypeLoader TypeName NIL T))
(* * in case new patches have been made since the sysout was made or the last greet)
(COND
((SETQ FullFileName (NC.FindFile (QUOTE POSTRELEASEPATCHES)))
(NC.LoadFileFromDirectories FullFileName)))
(for TypeName in NOTECARDTYPESTUBS unless (OR (NC.CardTypeRecord TypeName)
(MEMB TypeName NOTECARDTYPES)
(GETHASH TypeName NC.CardTypes))
do (NC.CardTypeStubLoader TypeName))
(* * Load the library packages requested by the user's NOTECARDSLIBRARYFILES parameters)
(for File in NOTECARDSLIBRARYFILES unless (GETPROP File (QUOTE FILEDATES))
do (COND
((SETQ FullFileName (NC.FindFile File))
(NC.LoadFileFromDirectories FullFileName))
(T (PRINT (CONCAT "NoteCards: Can't find library file: " File "."]
(for File in NOTECARDSLISPUSERSFILES do (NC.LoadFileFromDirectories File (QUOTE
LISPUSERSDIRECTORIES)))
(if (GETD (QUOTE START-TEDIT-KILLER))
then (START-TEDIT-KILLER))
(NCP.NoteCardsParameters NCINITIALGLOBALPARAMS])
)
(* * changes to NCDATABASE)
(DEFINEQ
(NC.PutMainCardData
[LAMBDA (Card UpdateUpdateListFlg UseOldDateFlg OverrideStream)
(* Randy.Gobbel "10-Jun-87 17:34")
(* * Write note card specified by ID to the database specified by Database stream)
(* * rht 7/9/85: Now puts out date after identifier. If UseOldDateFlg is non-nil, then use old date, otherwise use
current date.)
(* * rht 11/10/85: Updated to handle NoteFile and Card scheme.)
(* * fgh 11/20/85 Added call to NC.WriteCardPartHeader and the mechanism to write the start and end pointers of the
substance before calling the card type's putfn.)
(* * kirk 29Nov85 Renamed from NC.PutNoteCard)
(* * rht 1/23/86: Now takes optional OverrideStream arg. This, if given, overrides stream of card's notefile.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * fgh 2/6/86 Added support for version numbers on the substance put fn.)
(* * kirk 14Feb86 Merged above two changes)
(* * rht 2/14/86: Fixed so call to NC.WriteCardType takes Stream as arg.)
(* * rht 2/17/86: Fixed so calls to NC.WriteCardPartHeader and to NC.WriteRegion take Stream arg.)
(* * kef 7/16/86: Makes use of the NoteFile device vector PutCardPartFn.)
(* * kef 8/1/86: Added notification of status change.)
(* * fgh 8/31/86 Adapted to use NC.DoCardPartFn.)
(* * pmi 11/4/86 Reinstated Randy's change (1/23/86) which somehow got lost.)
(* * rht 11/14/86: Now makes sure hung var PutSuccessfulLoc is NIL if we were passed an OverrideStream.)
(* * rg 6/10/87 adds links cache if none already exists)
(DECLARE (GLOBALVARS NC.ItemIdentifier))
(LET (PutSuccessfulLoc)
(WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(NC.DoCardPartFn Put Card (QUOTE SUBSTANCE)
(LET ((Stream (OR (STREAMP OverrideStream)
(NC.CoerceToNoteFileStream Card)))
StartDataLoc EndLoc CardType StartSubstanceLoc
SubstanceVersion)
(* * Record update date on update list if necessary.)
(AND UpdateUpdateListFlg (NC.UpdateUpdateList Card))
(* * First write out the card part header)
(SETQ StartDataLoc (GETFILEPTR Stream))
(NC.WriteCardPartHeader Card NC.ItemIdentifier
[COND
(UseOldDateFlg (
NC.FetchItemDate
Card))
(T (NC.SetItemDate
Card
(DATE]
Stream)
(* * write out the type and region)
(NC.WriteCardType Stream (SETQ CardType
(NC.RetrieveType Card)))
(NC.WriteRegion Card Stream)
(* * Write out the dummy length pointer for and version byte the actual substance)
(SETQ StartSubstanceLoc (GETFILEPTR Stream))
(NC.WritePtr Stream 0 4)
(* * Write out the substance of the card.)
(SETQ SubstanceVersion (NC.ApplyFn PutFn Card Stream))
(* * Update the length pointer at beginning of substance Subtract four so that length is the length of the actual
substance and doesn't include the length pointer and version byte maintained here. Also updated the version number
returned by the put fn.)
(SETQ EndLoc (GETFILEPTR Stream))
(SETFILEPTR Stream StartSubstanceLoc)
(NC.WritePtr Stream (DIFFERENCE (DIFFERENCE EndLoc
StartSubstanceLoc)
4)
3)
(SETQ SubstanceVersion (OR SubstanceVersion 0))
(NC.WritePtr Stream SubstanceVersion 1)
(* * Update the length field at the beginning of the card info)
(SETFILEPTR Stream StartDataLoc)
(NC.WritePtr Stream (DIFFERENCE EndLoc StartDataLoc)
3)
(SETFILEPTR Stream EndLoc)
(* * Now update the Index to reflect the new data just written. Done last in case the substance putting bombed for
some reason.)
(replace (Card Status) of Card with (QUOTE
ACTIVE))
(* cause links cache to be created if not already in
existence)
(OR (fetch (Card Links) of Card)
(replace (Card FromLinks) of Card
with NIL))
(* * Don't put a reasonable value in the hung variable PutSuccessfulLoc if we were passed OverrideStream.)
(SETQ PutSuccessfulLoc
(if OverrideStream
then NIL
else StartDataLoc))
Card])
(NC.FixUpLinksInCardCopy
[LAMBDA (CardCopy CardHashArray LinksHashArray CurrentLinkLabels NewLinkLabels InterestedWindow
CopyExternalToLinksFlg CrossFileLinkModePropList)
(* rht: " 8-Jun-87 14:07")
(* * For all the links from or to CardCopy, change other endpoint's card according to mapping table in
CardHashArray. If other endpoint is a card not found in the hash array, then drop that link altogether.
The mapping from old link UIDs to new ones is in LinksHashArray. Any new link labels not in CurrentLinkLabels get
TCONC'ed onto NewLinkLabels.)
(* * rht 2/17/86: Now uses NC.ApplyFn instead of APPLY* for deleting and collecting references.)
(* * rht 11/1/86: Added missing var bindings and a BLOCK)
(* * rht 6/6/87: Added new args InterestedWindow, CopyExternalToLinksFlg, and CrossFileLinkModePropList to handle
optional copying of external links.)
(LET ((CardCopyType (NC.FetchType CardCopy)))
(* * Fix all the From links.)
(NC.SetFromLinks CardCopy (for Link in (NC.FetchFromLinks CardCopy) eachtime
(BLOCK)
bind SourceCard OldLinkUID LinkLabel
when (SETQ SourceCard (GETHASH (fetch (Link
SourceCard)
of Link)
CardHashArray))
collect (replace (Link DestinationCard) of Link
with CardCopy)
(replace (Link SourceCard) of Link
with SourceCard)
(replace (Link UID) of Link
with (OR (GETHASH (SETQ OldLinkUID
(fetch (Link UID)
of Link))
LinksHashArray)
(PUTHASH OldLinkUID (NC.MakeUID)
LinksHashArray)))
(* Keep track of link labels in case any are new.)
(OR (FMEMB (SETQ LinkLabel
(fetch (Link Label)
of Link))
CurrentLinkLabels)
(NC.SystemLinkLabelP LinkLabel)
(FMEMB LinkLabel (CAR NewLinkLabels))
(TCONC NewLinkLabels LinkLabel))
Link))
(* * Do it all again for the To links.)
(NC.SetToLinks CardCopy (for Link in (NC.FetchToLinks CardCopy) eachtime (BLOCK)
bind DestCard OldLinkUID LinkLabel
when (SETQ DestCard (GETHASH (fetch (Link
DestinationCard)
of Link)
CardHashArray))
collect (replace (Link SourceCard) of Link with
CardCopy)
(replace (Link DestinationCard) of Link
with DestCard)
(replace (Link UID) of Link
with (OR (GETHASH (SETQ OldLinkUID
(fetch (Link UID)
of Link))
LinksHashArray)
(PUTHASH OldLinkUID (NC.MakeUID)
LinksHashArray)))
(* Keep track of link labels in case any are new.)
(OR (FMEMB (SETQ LinkLabel (fetch
(Link Label) of Link))
CurrentLinkLabels)
(NC.SystemLinkLabelP LinkLabel)
(FMEMB LinkLabel (CAR NewLinkLabels))
(TCONC NewLinkLabels LinkLabel))
Link))
(* * Now fix the links inside imageobj's in the card's substance.)
(AND (fetch (Card LinkAnchorModesSupported) of CardCopy)
(for Link in (CAR (NC.ApplyFn CollectLinksFn CardCopy)) eachtime (BLOCK)
bind PreviousLink do (LET ((DestCard (fetch (Link DestinationCard)
of Link))
(LinkLabel (fetch (Link Label) of Link))
OldLinkUID DestCardCopy NewLink)
(COND
((SETQ DestCardCopy (GETHASH DestCard
CardHashArray))
(replace (Link SourceCard) of Link
with CardCopy)
(replace (Link DestinationCard) of Link
with DestCardCopy)
(replace (Link UID) of Link
with (OR (GETHASH
(SETQ OldLinkUID
(fetch (Link UID)
of Link))
LinksHashArray)
(PUTHASH OldLinkUID (
NC.MakeUID)
LinksHashArray)))
(* Keep track of link labels in case any are new.)
(OR (FMEMB LinkLabel CurrentLinkLabels)
(NC.SystemLinkLabelP LinkLabel)
(FMEMB LinkLabel (CAR NewLinkLabels))
(TCONC NewLinkLabels LinkLabel))
(SETQ PreviousLink Link))
([AND CopyExternalToLinksFlg
(if (NC.CrossFileLinkCardP DestCard)
then (SETQ DestCard
(NC.GetCrossFileLinkDestCard
DestCard InterestedWindow))
else DestCard)
(SETQ NewLink
(NC.MakeLink NIL LinkLabel DestCard
CardCopy
(fetch (Link
DisplayMode)
of Link)
(fetch (Link AnchorMode)
of Link)
NIL NIL PreviousLink
(
NC.ComputeCrossFileLinkMode
DestCard
CrossFileLinkModePropList
InterestedWindow]
(* It's an external link. Try to make a copy, possibly
resulting in a cross-file link.)
(* Smash the imageobj's link with contents of new one
we just made.)
[for FieldName in (RECORDFIELDNAMES
(QUOTE Link))
do (RECORDACCESS
FieldName Link (RECLOOK
(QUOTE Link))
(QUOTE REPLACE)
(RECORDACCESS FieldName NewLink
(RECLOOK
(QUOTE Link))
(QUOTE FETCH]
(SETQ PreviousLink Link))
(T (NC.ApplyFn DeleteLinksFn CardCopy Link])
(NC.GetMainCardData
[LAMBDA (Card OverrideStream) (* rht: "13-Mar-87 17:03")
(* Get a note card from the database. If IncludeDeletedCardsFlg is NIL, then return immediately if card is deleted
or free. Otherwise, get dekleted but not free cards.)
(* * rht 1/31/85: Now reads pointers from index array rather than file.)
(* * rht 7/9/85: Now gets date if notefile has newer data format.)
(* * rht 11/10/85 Updated to handle new Card scheme and NoteFile objects.)
(* * fgh 11/20/85 Added call to NC.ReadCardPartHeader and put in code to read Start and End pointers before calling
card type's getfn.)
(* * kirk 27Nov85 abstracted this function out of NC.GetNoteCard)
(* * rht 1/23/86: Now takes optional OverrideStream arg. This, if given, overrides stream of card's notefile.)
(* * rht 1/28/86: Now passes extra arg to NC.ReadCardPartHeader indicating that when we're overriding the notefile
stream, you shouldn't force UIDs on stream and in card to match.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * fgh 2/6/86 Added support for version numbers on the substance get fn.)
(* * kirk 14Feb86 Merged the above 4 changes)
(* * kef 7/16/86: Uses the device vector GetCardPartFn to set up the stream and stream pointer for reading.)
(* * kef 8/1/86: Moved the check for ACTIVE status to beginning.)
(* * fgh 8/31/86 Adpated to use NC.DoCardPartFn.)
(* * pmi 11/4/86 Reinstated Randy's changes (1/23/86 and 1/28/86) which somehow got lost.)
(* * rht 3/13/87: No longer goes to notefile if card hasn't been saved yet.)
(DECLARE (GLOBALVARS NC.ItemIdentifier))
(if (AND (EQ (fetch (Card Status) of Card)
(QUOTE ACTIVE))
(NOT (NC.FetchNewCardFlg Card)))
then (WITH.MONITOR (NC.FetchMonitor (fetch (Card NoteFile) of Card))
(NC.DoCardPartFn Get Card (QUOTE SUBSTANCE)
(LET ((Stream (OR (STREAMP OverrideStream)
(NC.CoerceToNoteFileStream Card)))
Length SubstanceVersion)
(* * Read the header info)
(NC.SetItemDate Card (NC.ReadCardPartHeader
Card NC.ItemIdentifier Stream
OverrideStream))
(* * read card type and region)
(NC.SetType Card (NC.ReadCardType Stream))
(NC.SetRegion Card (NC.ReadRegion Stream))
(* * Read the length of substance, then call the substance get fn)
(SETQ Length (NC.ReadPtr Stream 3))
(SETQ SubstanceVersion (NC.GetPtr Stream 1))
(NC.SetSubstance Card
(NC.ApplyFn GetFn Card Length
Stream
SubstanceVersion))
Card])
)
(* * changes to NCCONVERTVERSION2TO3)
(DEFINEQ
(NC.ReadVersion2MainCardData
[LAMBDA (Stream ID Card Version2HashArray FromNoteFile ToNoteFile)
(* fgh: "27-May-86 20:43")
(* * Stream should be positioned at the main data card part of ID. Get the main data and fill in for Card.)
(* * fgh 12/17/85 changed Apply of CollectReferencesFn to be done only if there is a CollectReferencesFn for the
card type)
(* * rht 5/7/86: Now only does the horrible kludge of smashing absolute pointers in the 1.2 file if the TEdit is
judged to be formatted. We check that by looking for the TEdit password at the end of the substance.)
(* * fgh 5/27/86 Added INTERSECTION call during conversion of links due to problems with browsers which have same
link icon represented twice in the browser.)
(LET (CardType Region StartPtr EndPtr Length TEditBasedFlg StartFormatPtr CollectReferencesFn
FormattedTEditP LinkIcons)
(NC.SetItemDate Card (NC.ReadVersion2CardPartHeader Stream ID NC.Version2ItemIdentifier))
(* * Read card type and region)
(NC.SetType Card (SETQ CardType (READ Stream)))
(SETQ TEditBasedFlg (NC.TEditBasedP CardType))
(READC Stream)
(NC.SetRegion Card (NC.ReadVersion2Region Stream))
(* * Read the substance pointers, compute the length, then call the substance get fn)
(SETQ StartPtr (NC.ReadPtr Stream 3))
(SETQ EndPtr (NC.ReadPtr Stream 3))
(SETQ Length (DIFFERENCE EndPtr StartPtr))
(* * Figure out whether the substance is TEdit formatted. In that case we have to smush absolute pointers.)
(SETQ FormattedTEditP (AND TEditBasedFlg (GREATERP Length 2)
(SETFILEPTR Stream (DIFFERENCE EndPtr 2))
(EQ (QUOTIENT (NC.ReadPtr Stream 2)
100)
NC.TEditPasswordDividedBy100)))
(* * A horrible kludge: Change the infamous file absolute pointer in the text stream to be file relative for
duration of the GetSubstance call.)
(if FormattedTEditP
then (SETFILEPTR Stream (DIFFERENCE EndPtr 8))
(SETQ StartFormatPtr (NC.ReadPtr Stream 4))
(SETFILEPTR Stream (DIFFERENCE EndPtr 8))
(NC.WritePtr Stream (DIFFERENCE StartFormatPtr StartPtr)
4))
(SETFILEPTR Stream StartPtr)
(NC.SetSubstance Card (NC.ApplyFn GetFn Card Length Stream -1))
(* * Now put back the infamous file absolute pointer.)
(if FormattedTEditP
then (SETFILEPTR Stream (DIFFERENCE EndPtr 8))
(NC.WritePtr Stream StartFormatPtr 4)
(SETFILEPTR Stream EndPtr))
(* * Now convert each link in the embedded link icons in the substance.)
(if (fetch (Card CollectLinksFn) of Card)
then (for LinkIcon in (INTERSECTION (SETQ LinkIcons
(CAR (NC.ApplyFn CollectLinksFn Card NIL
T)))
LinkIcons)
eachtime (BLOCK) do (NC.ConvertVersion2LinkIcon LinkIcon Card
Version2HashArray])
)
(* * following code reconstructs existing card types, or tries to, at least - do not include
in integration)
(LET [(TypeNames (REMOVE (QUOTE NoteCard)
(LET (collection)
[MAPHASH NC.CardTypes (FUNCTION (LAMBDA (REC NAME)
(push collection NAME]
collection]
(CLRHASH NC.CardTypes)
(NC.MakeCardTypesList)
[for fn in (QUOTE ((NC.AddCrossFileLink . CrossFileLink)
(NC.AddHashCard . Hash)
(NC.AddRegistryCard . Registry)
(NC.AddTextCard . Text)
(NC.AddSketchCard . Sketch)
(NC.AddGraphCard . Graph)
(NC.AddFileBoxCard . FileBox)
(NC.AddBrowserCard . Browser)
(NC.AddSearchCard . Search)
(NC.AddDocumentCard . Document)
(NC.AddLinkIndexCard . LinkIndex)
(NC.AddListCard . List)))
do
(if (GETD (CAR fn))
then
(APPLY (CAR fn))
(SETQ TypeNames (REMOVE (CDR fn)
TypeNames]
[for type in NOTECARDTYPESTUBS do (LET [(StubFn (PACK* (QUOTE NCAddStub.)
type
(QUOTE Card]
(if (AND (MEMB type TypeNames)
(NOT (GETHASH type NC.CardTypes))
(GETD StubFn))
then
(APPLY StubFn)
(SETQ TypeNames (REMOVE type TypeNames]
(if TypeNames then (PRINTOUT T "The following card types need to be redefined: " TypeNames T)))
(PUTPROPS RGPATCH061 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5049 23028 (NC.CardDirtyP 5059 . 5506) (NC.CollectReferences 5508 . 6840) (
NC.EditNoteCard 6842 . 9787) (NC.MakeNoteCard 9789 . 13120) (NC.QuitCard 13122 . 19103) (
NC.MarkCardDirty 19105 . 19714) (NC.FetchDefaultHeight 19716 . 19999) (NC.FetchDefaultWidth 20001 .
20285) (NC.FetchLinkAnchorModesSupported 20287 . 20546) (NC.FetchLinkDisplayMode 20548 . 20850) (
NC.FetchLinkIconAttachedBitMap 20852 . 22421) (NC.InstallTitleBarMiddleMenu 22423 . 23026)) (23061
27570 (NC.CardSubstanceVersionInspector 23071 . 26876) (NC.RobustGetSubstance 26878 . 27568)) (33001
48623 (NC.IsSubTypeOfP 33011 . 33467) (NC.ListOfCardTypes 33469 . 34269) (NC.RecomputeCardType 34271
. 35446) (NC.PropagateCardTypeFieldsDownward 35448 . 36241) (NC.SubTypesOfCardType 36243 . 36808) (
NC.InheritFieldsFromSuperType 36810 . 39121) (NC.AutoLoadCardType 39123 . 41944) (NC.MakeCardTypesList
41946 . 43802) (NC.AddCardType 43804 . 46443) (NC.CardTypeRecord 46445 . 47001) (NC.ModifyCardType
47003 . 48621)) (48657 49628 (NCP.CardTypeSuper 48667 . 49129) (NCP.CardTypeLinkDisplayMode 49131 .
49626)) (49663 49944 (NC.RegistryCardMakeFn 49673 . 49942)) (49979 50823 (
NC.InstallTextTitleBarMiddleMenu 49989 . 50821)) (50860 55030 (NC.MakeSketchCard 50870 . 52474) (
NC.BringUpSketchCard 52476 . 55028)) (55068 58607 (NC.MakeFileBox 55078 . 57622) (NC.AddFileBoxCard
57624 . 58605)) (58645 67586 (NC.BringUpBrowserCard 58655 . 64162) (NC.BrowserCardQuitFn 64164 . 64722
) (NC.AddBrowserCard 64724 . 67584)) (67623 69886 (NC.MakeSearchCard 67633 . 69884)) (69925 76787 (
NC.MakeDocument 69935 . 76785)) (76827 79614 (NC.MakeLinkIndex 76837 . 78906) (NC.AddLinkIndexCard
78908 . 79612)) (79646 84821 (NC.DelReferencesToCard 79656 . 83090) (NC.FetchLinkIconForLink 83092 .
83680) (NC.UpdateLinkImages 83682 . 84819)) (84857 85497 (NC.InstallTitleBarLeftMenu 84867 . 85495)) (
85531 88527 (NC.PostGreet 85541 . 88525)) (88562 103093 (NC.PutMainCardData 88572 . 93558) (
NC.FixUpLinksInCardCopy 93560 . 100029) (NC.GetMainCardData 100031 . 103091)) (103138 106463 (
NC.ReadVersion2MainCardData 103148 . 106461)))))
STOP