(FILECREATED " 8-Feb-85 02:54:08" {PHYLUM}<NOTECARDS>RELEASE1.2>FGHPATCH001.;4 15653
changes to: (VARS FGHPATCH001COMS)
(FNS NC.CheckForNeededTruncation NC.DelToLink NC.PutProp NC.GetProp
NC.MakeBrowserCard)
previous date: " 7-Feb-85 21:23:31" {PHYLUM}<NOTECARDS>RELEASE1.2>FGHPATCH001.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FGHPATCH001COMS)
(RPAQQ FGHPATCH001COMS ((* * New Fns)
(FNS NC.PutProp NC.GetProp)
(* * Redefined Fns)
(FNS NC.MakeBrowserCard NC.DelFromLink NC.DelToLink
NC.CheckForNeededTruncation)))
(* * New Fns)
(DEFINEQ
(NC.PutProp
(LAMBDA (ID Prop Value DatabaseStream) (* fgh: " 7-Feb-85 21:20")
(* * Put a property value pair on the NoteCardsPropList property of ID. ID must be active.)
(PROG ((PropList (NC.FetchPropList ID)))
(COND
(PropList (LISTPUT PropList Prop Value)
(NC.SetPropList ID PropList))
(T (NC.SetPropList ID (LIST Prop Value)))))))
(NC.GetProp
(LAMBDA (ID Prop DatabaseStream) (* fgh: " 7-Feb-85 21:20")
(* * Get the value of a property on the NoteCardsPropList property of ID. ID must be active.)
(LISTGET (NC.FetchPropList ID)
Prop)))
)
(* * Redefined Fns)
(DEFINEQ
(NC.MakeBrowserCard
(LAMBDA (ID Title NoDisplayFlg ListOfRootIDsAndListOfLinkLabels)
(* fgh: " 7-Feb-85 21:22")
(* Make a browser card with id ID using root at RootID and the link following predictae specified by Predicate.
IF Root and/or ListOfLinkLabels not specified, ask the user.)
(* * rht 8/3/84: Changed to call NC.AskLinkLabel with its ReverseLinkLabel parameter set to T.)
(* * fgh 10/2/84 Changed Link Icons to be image objects in NodeLabel of Graph Npodes rather than annotations on
graph nodes.)
(* * rht 10/19/84: Fixed setting up of browser card's prop list in case NoDisplayFlg is T so we have no Window.
Now NC.MakeLinksLegend returns the label pairs.)
(* * rht 11/27/84: Removed the WINDOWADDPROP call to put NC.GraphCardCloseFn on the CLOSEFN of the window.
This causes trouble. NC.QuitCard will get put on by NC.MakeNoteCard and that's enough.)
(* * rht 1/3/85: Now puts a dummy region of the right size if the NoDisplayFlg is on.)
(* * rht 1/15/85: Put hooks for AddNode, AddLink, etc. so editing graph edits underlying structure.)
(PROG (Lattice Window Graph PropList BrowserSpecs (RootIDs (MKLIST (CAR
ListOfRootIDsAndListOfLinkLabels)))
RootNodes
(ListOfLinkLabels (CADR ListOfRootIDsAndListOfLinkLabels))
LabelPairs)
(NC.ActivateCard ID)
(COND
((NULL NoDisplayFlg)
(SETQ Window (CREATEW (NC.DetermineDisplayRegion ID NIL)
(NC.FetchTitle ID)
NIL))))
(SETQ RootIDs (OR RootIDs (PROGN (NC.PrintMsg Window T
"Please select the Cards and/or Boxes the browser should start from."
(CHARACTER 13))
(NC.SelectNoteCards NIL NIL NC.SelectingBrowserSourceMenu
Window))))
(COND
((OR (NULL RootIDs)
(NULL (OR ListOfLinkLabels (SETQ ListOfLinkLabels
(NC.AskLinkLabel Window T T NIL T T)))))
(NC.DeactivateCard ID)
(CLOSEW Window)
(RETURN)))
(SETQ BrowserSpecs (COND
(NC.SpecialBrowserSpecsFlg (NC.AskBrowserSpecs Window))
(T (create BrowserSpecs))))
(OR NoDisplayFlg (NC.PrintMsg Window NIL (CHARACTER 13)
"Computing browser graph. Please wait. ..."))
(SETQ RootNodes (for RootID in RootIDs
collect (SETQ Lattice (NC.GrowLinkLattice RootID Lattice
ListOfLinkLabels ID
PSA.Database))
(PACK* ID RootID)))
(SETQ LabelPairs (NC.MakeLinksLegend Lattice Window))
(OR NoDisplayFlg (WINDOWPROP Window (QUOTE NoteCardID)
ID))
(* * Link destination id information stored in NodeLabel field into a LinkIcon for display)
(for Node in Lattice do (replace (GRAPHNODE NODELABEL) of Node
with (NC.MakeLinkIcon (NC.MakeLink Window
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE NODELABEL)
of Node)
ID NIL))))
(SETQ Graph (LAYOUTGRAPH Lattice RootNodes (fetch (BrowserSpecs Format) of BrowserSpecs)
(fetch (BrowserSpecs Font) of BrowserSpecs)
(fetch (BrowserSpecs MotherD) of BrowserSpecs)
(fetch (BrowserSpecs PersonalD) of BrowserSpecs)
(fetch (BrowserSpecs FamilyD) of BrowserSpecs)))
(OR NoDisplayFlg (NC.PrintMsg Window NIL "Done!"))
(NC.SetSubstance ID Graph)
(NC.PutProp ID (QUOTE BrowserLinkLabels)
(LIST (OR ListOfLinkLabels NC.SubBoxLinkLabel)))
(NC.PutProp ID (QUOTE BrowserRoot)
RootIDs)
(NC.PutProp ID (QUOTE BrowserLinksLegend)
LabelPairs)
(AND NC.SpecialBrowserSpecsFlg (NC.PutProp ID (QUOTE BrowserSpecs)
(LIST BrowserSpecs)))
(NC.SetPropListDirtyFlg ID T)
(COND
(NoDisplayFlg (RETURN ID)))
(replace (GRAPH GRAPH.ADDNODEFN) of Graph with (FUNCTION NC.StructEditAddNodeFn))
(replace (GRAPH GRAPH.DELETENODEFN) of Graph with (FUNCTION NC.StructEditDeleteNodeFn))
(replace (GRAPH GRAPH.ADDLINKFN) of Graph with (FUNCTION NC.StructEditAddLinkFn))
(replace (GRAPH GRAPH.DELETELINKFN) of Graph with (FUNCTION NC.StructEditDeleteLinkFn))
(replace (GRAPH GRAPH.MOVENODEFN) of Graph with (FUNCTION NC.GraphMoveNodeFn))
(replace (GRAPH GRAPH.FONTCHANGEFN) of Graph with (FUNCTION NC.GraphFontChangeFn))
(SHOWGRAPH Graph Window (FUNCTION NC.GraphCardLeftButtonFn)
(FUNCTION NC.GraphCardMiddleButtonFn)
NIL T)
(NC.SetupTitleBarMenu Window ID (QUOTE Browser))
(NC.ClearMsg Window T)
(RETURN Window))))
(NC.DelFromLink
(LAMBDA (Link DatabaseStream NoOrphanHookFlg) (* fgh: " 8-Feb-85 01:55")
(* Delete a FromLink from card on DatabaseStream.
Hook card to orphan if this is the last link.)
(* * rht 11/15/84: Changed decision as to when to orphanize a card. Now must have deleted its last link
(not just last subbox or filedcard link). Also checks that link doesn't point from card to itself.)
(* * rht 12/1/84: Now doesn't do any work unless ID is valid, i.e. not DELETED or FREE.)
(PROG ((ID (fetch (NOTECARDLINK DESTINATIONID) of Link)))
(COND
((NOT (NC.ValidID ID)))
((NC.ActiveCardP ID)
(NC.SetFromLinks ID (DREMOVE (for OldLink in (NC.FetchFromLinks ID)
thereis (AND (EQP (fetch (NOTECARDLINK LINKID)
of Link)
(fetch (NOTECARDLINK LINKID)
of OldLink))
OldLink))
(NC.FetchFromLinks ID)))
(NC.SetLinksDirtyFlg ID T)
(AND (NULL NoOrphanHookFlg)
(NOT (FMEMB ID NC.TopLevelCards))
(NOT (EQ (fetch (NOTECARDLINK SOURCEID) of Link)
ID))
(NULL (NC.FetchNewCardFlg ID))
(NOT (EQ (fetch (NOTECARDLINK SOURCEID) of Link)
NC.OrphanID))
(COND
((OR (NULL (NC.FetchFromLinks ID))
(for Link in (NC.FetchFromLinks ID) always (EQ (fetch (NOTECARDLINK
SOURCEID)
of Link)
ID)))
(NC.PrintMsg NIL T "You have just removed the last link to " (NC.RetrieveTitle
ID)
"."
(CHARACTER 13)
"It is being filed in the Orphan FileBox.")
(NC.HookToOrphanCard ID NC.OrphanID DatabaseStream))
((for Link in (NC.FetchFromLinks ID) never (FMEMB (fetch (NOTECARDLINK LINKLABEL)
of Link)
(QUOTE (SubBox FiledCard))))
(NC.PrintMsg NIL T "You have just unfiled " (NC.RetrieveTitle ID)
" from its last filebox."
(CHARACTER 13)
"It is being filed in the Orphan FileBox.")
(NC.HookToOrphanCard ID NC.OrphanID DatabaseStream)))))
(T (WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.AddFromLink")
(NC.GetLinks ID DatabaseStream)
(NC.SetFromLinks ID (DREMOVE (for OldLink in (NC.FetchFromLinks ID)
thereis
(AND (EQ (fetch (NOTECARDLINK LINKID)
of Link)
(fetch (NOTECARDLINK LINKID)
of OldLink))
OldLink))
(NC.FetchFromLinks ID)))
(NC.SetLinksDirtyFlg ID T)
(NC.PutLinks ID DatabaseStream)
(AND (NULL NoOrphanHookFlg)
(NOT (FMEMB ID NC.TopLevelCards))
(NOT (EQ (fetch (NOTECARDLINK SOURCEID) of Link)
ID))
(NULL (NC.FetchNewCardFlg ID))
(NOT (EQ (fetch (NOTECARDLINK SOURCEID) of Link)
NC.OrphanID))
(COND
((OR (NULL (NC.FetchFromLinks ID))
(for Link in (NC.FetchFromLinks ID)
always (EQ (fetch (NOTECARDLINK SOURCEID) of Link)
ID)))
(NC.PrintMsg NIL T "You have just removed the last link to "
(NC.RetrieveTitle ID)
"."
(CHARACTER 13)
"It is being filed in the Orphan FileBox.")
(NC.HookToOrphanCard ID NC.OrphanID DatabaseStream))
((for Link in (NC.FetchFromLinks ID)
never (FMEMB (fetch (NOTECARDLINK LINKLABEL) of Link)
(QUOTE (SubBox FiledCard))))
(NC.PrintMsg NIL T "You have just unfiled " (NC.RetrieveTitle
ID)
" from its last filebox."
(CHARACTER 13)
"It is being filed in the Orphan FileBox.")
(NC.HookToOrphanCard ID NC.OrphanID DatabaseStream)))))
(NC.SetFromLinks ID NIL)
(NC.SetToLinks ID NIL)))
(RETURN Link))))
(NC.DelToLink
(LAMBDA (Link DatabaseStream) (* fgh: " 8-Feb-85 01:56")
(* * Delete ToLink spoecified by Link from cards on DatabasseStream)
(* * rht 12/1/84: Now doesn't do any work unless ID is valid, i.e. not DELETED or FREE.)
(PROG ((ID (fetch (NOTECARDLINK SOURCEID) of Link)))
(COND
((NOT (NC.ValidID ID)))
((NC.ActiveCardP ID)
(NC.SetToLinks ID (DREMOVE (for OldLink in (NC.FetchToLinks ID)
thereis (AND (EQP (fetch (NOTECARDLINK LINKID)
of Link)
(fetch (NOTECARDLINK LINKID)
of OldLink))
OldLink))
(NC.FetchToLinks ID)))
(NC.SetLinksDirtyFlg ID T))
(T (WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.AddFromLink")
(NC.GetLinks ID DatabaseStream)
(NC.SetToLinks ID (DREMOVE (for OldLink in (NC.FetchToLinks ID)
thereis (AND (EQ (fetch (NOTECARDLINK
LINKID)
of Link)
(fetch (NOTECARDLINK
LINKID)
of OldLink))
OldLink))
(NC.FetchToLinks ID)))
(NC.SetLinksDirtyFlg ID T)
(NC.PutLinks ID DatabaseStream))
(NC.SetFromLinks ID NIL)
(NC.SetToLinks ID NIL)))
(RETURN Link))))
(NC.CheckForNeededTruncation
(LAMBDA (DatabaseStream Access) (* fgh: " 8-Feb-85 02:42")
(* * See if there was a crash or aborted close last time. That is, has the notefile got junk beyond the last
checkpoint EOFPTR? If so, ask if user wants to save the extra junk in a file. In any case, truncate at the old
point. If the version number is less than 2, change to a version 2 file and write the the new checkpoint pointer.)
(PROG (FullFileName Version LastChkptPtr EndPtr SaveFile SaveStream Ptr)
(SETFILEPTR DatabaseStream 7)
(SETQ Version (NC.GetPtr DatabaseStream 1))
(COND
((LESSP Version 2) (* Pronounce this a version 2 file and write the new
lastchkptr value.)
(SETFILEPTR DatabaseStream 7)
(NC.PutPtr DatabaseStream 2 1)
(SETFILEPTR DatabaseStream 8)
(SETQ Ptr (GETEOFPTR DatabaseStream))
(NC.PutPtr DatabaseStream Ptr)
(RETURN NIL)))
(SETFILEPTR DatabaseStream 8)
(SETQ LastChkptPtr (NC.GetPtr DatabaseStream))
(SETQ EndPtr (GETEOFPTR DatabaseStream))
(SETQ FullFileName (FULLNAME DatabaseStream))
(COND
((LESSP LastChkptPtr EndPtr)
(NC.PrintMsg NIL T "Last " (IDIFFERENCE EndPtr LastChkptPtr)
" bytes of "
(FULLNAME DatabaseStream)
" were written since last checkpoint or successful close."
(CHARACTER 13))
(COND
((NC.YesP (NC.AskUser "Want to save this info in a file? " "--" "Yes" NIL NIL NIL T))
(COND
((AND (SETQ SaveFile (NC.AskUser (CONCAT (CHARACTER 13)
"File to save info in: ")
"--" NIL NIL NIL T))
(SETQ SaveStream (OPENSTREAM SaveFile (QUOTE OUTPUT))))
(NC.PrintMsg NIL T "Saving extra info to " SaveFile " ...")
(COPYBYTES DatabaseStream SaveStream LastChkptPtr EndPtr)
(CLOSEF SaveStream)
(NC.PrintMsg NIL NIL "Done." (CHARACTER 13)))
(T (NC.PrintMsg NIL T "Can't open " SaveFile "." (CHARACTER 13)
"Open aborted."
(CHARACTER 13))
(RETURN (QUOTE ABORT))))))
(COND
((NC.YesP (NC.AskUser (CONCAT (CHARACTER 13)
"Want to truncate " FullFileName "?")
"--" "Yes" NIL NIL NIL T))
(NC.PrintMsg NIL T "Truncating file " FullFileName " ...")
(CLOSEF DatabaseStream)
(COND
((NOT (SETFILEINFO FullFileName (QUOTE LENGTH)
LastChkptPtr))
(NC.PrintMsg NIL NIL "Couldn't truncate " FullFileName "." (CHARACTER 13)
"Open aborted."
(CHARACTER 13))
(RETURN (QUOTE ABORT))))
(NC.PrintMsg NIL T "Done." (CHARACTER 13))
(RETURN (OPENSTREAM FullFileName Access)))
(T (NC.PrintMsg NIL NIL (CHARACTER 13)
"Open aborted."
(CHARACTER 13))
(RETURN (QUOTE ABORT)))))))))
)
(PUTPROPS FGHPATCH001 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (636 1364 (NC.PutProp 646 . 1085) (NC.GetProp 1087 . 1362)) (1391 15571 (
NC.MakeBrowserCard 1401 . 6636) (NC.DelFromLink 6638 . 10947) (NC.DelToLink 10949 . 12417) (
NC.CheckForNeededTruncation 12419 . 15569)))))
STOP