(FILECREATED " 9-Dec-84 19:04:55" {DSK}<LISPFILES>RHTPATCH005.;6 42763
changes to: (VARS RHTPATCH005COMS NC.FileBoxIcon NC.SketchCardIcon NC.GraphCardIcon
NC.TextCardIcon)
(FNS NC.CheckContentsHooks NC.InsureProperFiling NC.LinkIconDisplayFn
NC.MakeContentsCard NC.MakeContentsHooks NC.AddParents NC.MakeTEditLeftMenu
NC.LinkIconImageBoxFn NC.InsertLinkBeforeMarker NC.PlaceMarkerDisplayFn
NC.PlaceMarkerImageBoxFn NC.MakeChildLink NC.FileBoxCollectChildren
NC.DetermineContentsCards NC.LinksLegendReshapeFn NC.MakeLinksLegendMenu
NC.BringUpBrowserCard NC.GetTypeIcon)
previous date: " 4-Dec-84 22:02:02" {PHYLUM}<PSA>NOTECARDS>RELEASE1.1>RHTPATCH005.;1)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH005COMS)
(RPAQQ RHTPATCH005COMS ((FNS NC.LinkIconDisplayFn NC.LinkIconImageBoxFn NC.GetTypeIcon
NC.InsertLinkBeforeMarker NC.MakeContentsCard NC.MakeNoteCard
NC.CheckTitle NC.UpdateRegionData NC.LinksLegendReshapeFn
NC.MakeLinksLegendMenu NC.BringUpBrowserCard NC.PlaceMarkerDisplayFn
NC.PlaceMarkerImageBoxFn NC.InsertLinkBeforeMarker NC.MakeChildLink
NC.FileBoxCollectChildren NC.MakeContentsHooks NC.CheckContentsHooks
NC.AddParents NC.MakeTEditLeftMenu NC.InsureProperFiling)
(BITMAPS NC.FileBoxIcon NC.GraphCardIcon NC.SketchCardIcon NC.TextCardIcon)
(GLOBALVARS NC.FileBoxIcon NC.GraphCardIcon NC.SketchCardIcon NC.TextCardIcon)))
(DEFINEQ
(NC.LinkIconDisplayFn
(LAMBDA (ImageObj ImageStream STREAMTYPE TEXTSTREAM SCALE TitleFlg)
(* rht: " 8-Dec-84 16:17")
(* * Display a link icon)
(* * rht 11/13/84: Made width of box lines also scale dependent.)
(* * rht 12/4/84: Hacked so type-dependent icons come out optionally to left of text.)
(PROG (YSize XSize Left Bottom DisplayType Window ID Title Label BoxLeft BoxBottom BoxWidth
BoxHeight TextLeft TextBaseLine ImageBox (Scale (DSPSCALE NIL ImageStream))
(Link (NC.FetchLinkFromLinkIcon ImageObj))
(Font (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE BOLD)
NIL ImageStream))
TypeIcon)
(* * Determine what type of Display to do)
(SETQ DisplayType (COND
(TitleFlg (QUOTE Title))
((fetch (NOTECARDLINK DISPLAYMODE) of Link))
(T (QUOTE Icon))))
(SETQ ID (fetch (NOTECARDLINK DESTINATIONID) of Link))
(AND (FMEMB DisplayType (QUOTE (Title Both)))
(SETQ Title (NC.RetrieveTitle ID PSA.Database)))
(AND (FMEMB DisplayType (QUOTE (Label Both)))
(SETQ Label (fetch (NOTECARDLINK LINKLABEL) of Link)))
(if (EQ DisplayType (QUOTE SourceTitle))
then (SETQ Title (NC.RetrieveTitle (SETQ ID (fetch (NOTECARDLINK SOURCEID)
of Link)))))
(SETQ TypeIcon (NC.GetTypeIcon (NC.FetchType ID)))
(* * Get the image box info for this icon)
(SETQ ImageBox (OR (IMAGEOBJPROP ImageObj (QUOTE BOUNDBOX))
(NC.LinkIconImageBoxFn ImageObj ImageStream NIL NIL NIL DisplayType
Title Label)))
(SETQ XSize (fetch (IMAGEBOX XSIZE) of ImageBox))
(SETQ YSize (fetch (IMAGEBOX YSIZE) of ImageBox))
(SETQ Bottom (IDIFFERENCE (DSPYPOSITION NIL ImageStream)
(fetch (IMAGEBOX YDESC) of ImageBox)))
(SETQ Left (DSPXPOSITION NIL ImageStream))
(* * Put out the icon bitmap for the appropriate type.)
(if (OR NC.AttachBitmapsToLinkIconsFlg (EQ DisplayType (QUOTE Icon)))
then (SELECTQ (OR STREAMTYPE (SETQ STREAMTYPE (IMAGESTREAMTYPE ImageStream)))
(DISPLAY (BITBLT TypeIcon 0 0 ImageStream (IPLUS Scale Left)
(IPLUS Scale Bottom)))
(PRESS (\WRITEPRESSBITMAP TypeIcon (IPLUS Scale Left)
(IPLUS Scale Bottom)
NIL NIL ImageStream))
(INTERPRESS (MOVETO (IPLUS Scale Left)
(IPLUS Scale Bottom)
ImageStream)
(SHOWBITMAP.IP ImageStream TypeIcon NIL NIL NIL))
(NC.ReportError "NC.LinkIconDisplayFn" (CONCAT STREAMTYPE
" is not a stream type that Notecards knows about"))))
(if (EQ DisplayType (QUOTE Icon))
then (RETURN))
(* * Draw a box around the border of the link icon)
(SETQ BoxLeft (IPLUS (if NC.AttachBitmapsToLinkIconsFlg
then (TIMES Scale (BITMAPWIDTH TypeIcon))
else Scale)
Left))
(SETQ BoxBottom (IPLUS Scale Bottom))
(SETQ BoxWidth (IDIFFERENCE XSize (TIMES Scale (PLUS 4 (if NC.AttachBitmapsToLinkIconsFlg
then (BITMAPWIDTH TypeIcon)
else 0)))))
(SETQ BoxHeight (IDIFFERENCE YSize (TIMES Scale 4)))
(MOVETO BoxLeft BoxBottom ImageStream)
(RELDRAWTO BoxWidth 0 Scale NIL ImageStream)
(RELDRAWTO 0 BoxHeight Scale NIL ImageStream)
(RELDRAWTO (MINUS BoxWidth)
0 Scale NIL ImageStream)
(* * Enter the appropriate text.)
(SETQ TextLeft (IPLUS BoxLeft (TIMES Scale 5)))
(SETQ TextBaseLine (IPLUS Bottom (TIMES Scale 3)
(FONTPROP Font (QUOTE DESCENT))))
(DSPXPOSITION TextLeft ImageStream)
(DSPYPOSITION TextBaseLine ImageStream)
(DSPFONT (PROG1 (DSPFONT Font ImageStream)
(PRIN1 (SELECTQ DisplayType
(SourceTitle Title)
(Title Title)
(Label (CONCAT "<" Label ">"))
(Both (CONCAT "<" Label ">" " " Title))
"")
ImageStream))
ImageStream))))
(NC.LinkIconImageBoxFn
(LAMBDA (ImageObj ImageStream CurrentX RightMargin DummyArg DisplayType Title Label)
(* rht: " 7-Dec-84 19:16")
(* * rht 9/20/84: Now scales result before returning by proper amount depending on stream type.
e.g. for PRESS and INTERPRESS.)
(* * rht 11/13/84: In computation of XSIZE, extra width is figured using characters in the font, "nn", rather than
absolute pixel count.)
(PROG (FONT Window ID NoteCardType (Link (NC.FetchLinkFromLinkIcon ImageObj))
(Scale (DSPSCALE NIL ImageStream))
TypeIcon)
(SETQ DisplayType (COND
((EQ DisplayType T)
(QUOTE Title))
(DisplayType DisplayType)
((fetch (NOTECARDLINK DISPLAYMODE) of Link))
(T (QUOTE Icon))))
(AND (FMEMB DisplayType (QUOTE (Title Both)))
(OR Title (SETQ Title (NC.RetrieveTitle (SETQ ID (fetch (NOTECARDLINK DESTINATIONID)
of Link))
PSA.Database))))
(AND (EQ DisplayType (QUOTE SourceTitle))
(OR Title (SETQ Title (NC.RetrieveTitle (SETQ ID (fetch (NOTECARDLINK SOURCEID)
of Link))
PSA.Database))))
(AND (FMEMB DisplayType (QUOTE (Label Both)))
(OR Label (SETQ Label (fetch (NOTECARDLINK LINKLABEL) of Link))))
(SETQ TypeIcon (NC.GetTypeIcon (NC.FetchType ID)))
(RETURN (create IMAGEBOX
XSIZE ←(IPLUS (TIMES Scale (if (OR NC.AttachBitmapsToLinkIconsFlg
(EQ DisplayType (QUOTE Icon)))
then (BITMAPWIDTH TypeIcon)
else 0))
(if (EQ DisplayType (QUOTE Icon))
then 0
else (STRINGWIDTH (CONCAT "nn"
(SELECTQ DisplayType
(SourceTitle Title)
(Title Title)
(Label (CONCAT "<" Label
">"))
(Both (CONCAT "<" Label
">"
" " Title))
" "))
(SETQ FONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE BOLD)
NIL ImageStream))))
)
YSIZE ←(IMAX (TIMES Scale (BITMAPHEIGHT TypeIcon))
(PLUS (FONTPROP FONT (QUOTE HEIGHT))
(TIMES Scale 8)))
YDESC ←(COND
(RightMargin (* This is in a TEdittextstream)
(FONTPROP FONT (QUOTE DESCENT)))
(T 0))
XKERN ← 0)))))
(NC.GetTypeIcon
(LAMBDA (Type) (* rht: " 4-Dec-84 20:06")
(* * Return the bitmap icon for the given type.)
(SELECTQ Type
(FileBox NC.FileBoxIcon)
(Sketch NC.SketchCardIcon)
((Graph Browser)
NC.GraphCardIcon)
NC.TextCardIcon)))
(NC.InsertLinkBeforeMarker
(LAMBDA (SourceID DestinationID LinkLabel DisplayMode Marker# DatabaseStream NoSpacerFlg)
(* rht: " 7-Dec-84 20:06")
(* Insert a link to DestinationID in SourceID just
before the Marker#'th place marker object)
(* * rht 12/7/84: Now returns the newly created link.)
(PROG (Objects TextStream TextObject SEL InsertCharPtr (Spacer (CONCAT (CHARACTER 13)))
Link)
(COND
((NC.ActiveCardP SourceID)
(SETQ TextStream (NC.FetchSubstance SourceID))
(SETQ TextObject (TEXTOBJ TextStream))
(COND
((AND (SETQ Objects (TEDIT.LIST.OF.OBJECTS TextObject (FUNCTION NC.PlaceMarkerP)))
(FIXP Marker#))
(COND
((EQ Marker# 0)
(TEDIT.SETSEL TextStream 1 0 (QUOTE LEFT)))
((IGREATERP Marker# (FLENGTH Objects))
(TEDIT.SETSEL TextStream (GETEOFPTR TextStream)
0
(QUOTE RIGHT)))
(T (TEDIT.SETSEL TextStream (CADAR (FNTH Objects Marker#))
0
(QUOTE LEFT)))))
(NC.MarkersInFileBoxesFlg (TEDIT.SETSEL TextStream (GETEOFPTR TextStream)
0
(QUOTE RIGHT))))
(SETQ SEL (fetch (TEXTOBJ SEL) of TextObject))
(SETQ Link (NC.InsertLinkInText TextStream LinkLabel DestinationID SourceID DisplayMode)
)
(COND
((NULL NoSpacerFlg)
(TEDIT.SETSEL TextStream (SELECTQ (fetch (SELECTION POINT) of SEL)
(LEFT (SUB1 (fetch (SELECTION CH#) of SEL)))
(RIGHT (IMIN (ADD1 (fetch (TEXTOBJ TEXTLEN)
of TextObject))
(ADD1 (fetch (SELECTION CHLIM)
of SEL))))
NIL)
0
(QUOTE RIGHT))
(TEDIT.INSERT TextStream Spacer))))
(T (WITH.MONITOR (NC.FetchMonitor DatabaseStream)
(COND
((NC.IDP (NC.GetNoteCard SourceID DatabaseStream))
(SETQ TextStream (NC.FetchSubstance SourceID))
(SETQ TextObject (TEXTOBJ TextStream))
(COND
((AND (SETQ Objects (TEDIT.LIST.OF.OBJECTS TextObject
(FUNCTION
NC.PlaceMarkerP)))
(FIXP Marker#))
(COND
((EQ Marker# 0)
(TEDIT.SETSEL TextStream 1 0 (QUOTE LEFT)))
((IGREATERP Marker# (FLENGTH Objects))
(TEDIT.SETSEL TextStream (GETEOFPTR TextStream)
0
(QUOTE RIGHT)))
(T (TEDIT.SETSEL TextStream (CADAR (FNTH Objects Marker#))
0
(QUOTE LEFT)))))
(NC.MarkersInFileBoxesFlg (TEDIT.SETSEL TextStream (GETEOFPTR
TextStream)
0
(QUOTE RIGHT))))
(SETQ SEL (fetch (TEXTOBJ SEL) of TextObject))
(SETQ Link (NC.InsertLinkInText TextStream LinkLabel DestinationID
SourceID DisplayMode))
(COND
((NULL NoSpacerFlg)
(TEDIT.SETSEL TextStream
(SELECTQ (fetch (SELECTION POINT) of SEL)
(LEFT (SUB1 (fetch (SELECTION CH#)
of SEL)))
(RIGHT (IMIN (ADD1 (fetch (TEXTOBJ
TEXTLEN)
of TextObject))
(ADD1 (fetch (SELECTION
CHLIM)
of SEL))))
NIL)
0
(QUOTE RIGHT))
(TEDIT.INSERT TextStream Spacer)))
(NC.PutNoteCard SourceID DatabaseStream)
(NC.PutLinks SourceID DatabaseStream)
(NC.DeactivateCard SourceID))))))
(RETURN Link))))
(NC.MakeContentsCard
(LAMBDA (ID Title DontDisplay) (* rht: " 8-Dec-84 17:03")
(* Make up a blank contents card, hook it to the user
specified parent contents cards, and display it.)
(* * rht 12/2/84: In DontDisplay case, changed to return ID rather than TextStream.)
(* * rht 12/8/84: Massive shaving. Took out code to force filing now (at creation time))
(PROG (Window TextStream (Spacer (CONCAT (CHARACTER 13)
(CHARACTER 13))))
(SETQ TextStream (OPENTEXTSTREAM ""))
(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))
(T (TEDIT.INSERT TextStream Spacer 1)))
(NC.SetSubstance ID TextStream)
(NC.SetRegion ID (CREATEREGION 0 0 PSA.ContentsCardDefaultWidth
PSA.ContentsCardDefaultHeight))
(COND
(DontDisplay (RETURN ID)))
(SETQ Window (CREATEW (GETBOXREGION PSA.ContentsCardDefaultWidth
PSA.ContentsCardDefaultHeight (GETMOUSEX)
(IDIFFERENCE (GETMOUSEY)
PSA.ContentsCardDefaultHeight)
NIL "Please specify location for the new FileBox")
(NC.SetTitle ID (OR Title "Untitled"))
(NC.DetermineBorderWidth (QUOTE CONTENTS))))
(WINDOWPROP Window (QUOTE NoteCardsLeftButtonMenu)
(NC.MakeTEditLeftMenu (NC.FetchType ID)))
(WINDOWPROP Window (QUOTE NoteCardsMiddleButtonMenu)
(NC.MakeTEditMiddleMenu)) (* Display the card)
(WINDOWPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.ShrinkFn))
(TEDIT TextStream Window NIL (LIST (QUOTE FONT)
NC.DefaultFont
(QUOTE TITLEMENUFN)
(FUNCTION NC.TEditMenuFn)))
(until (WINDOWPROP Window (QUOTE TEXTSTREAM)) do (BLOCK))
(NC.ActivateCard ID)
(replace (TEXTOBJ \DIRTY) of (TEXTOBJ TextStream) with T)
(AND (GETPROMPTWINDOW Window NIL NIL T)
(PROG1 (DISMISS 1000)
(NC.ClearMsg Window T)))
(RETURN Window))))
(NC.MakeNoteCard
(LAMBDA (NoteCardType Title NoDisplayFlg TypeSpecificArgs ID)
(* rht: " 6-Dec-84 14:32")
(* Make a new note card of type NoteCardType.
If type note specified, ask the user.)
(PROG (ReturnValue CopyID Window)
(AND (SETQ NoteCardType (OR NoteCardType (NC.AskNoteCardType)))
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(OR (NC.IDP ID)
(SETQ ID (NC.GetNewID PSA.Database)))
(NC.SetNewCardFlg ID T)
(NC.ActivateCard ID)
(OR (NC.FetchType ID)
(NC.SetType ID NoteCardType))
(COND
((OR (ERSETQ (SETQ ReturnValue (APPLY* (NC.MakeCardFn NoteCardType)
ID Title NoDisplayFlg
TypeSpecificArgs)))
(SETPROPLIST ID NIL))
(SETQ Window (WINDOWP ReturnValue))
(COND
((NULL (NC.FetchTitle ID))
(SETQ Title (NC.SetTitle ID (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 ID (MKSTRING (NC.FetchTitle ID)))))
(COND
(Window (WINDOWADDPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.QuitCard)
(QUOTE FIRST))
(WINDOWPROP Window (QUOTE NoteCardID)
ID)))
(NC.SetTitleDirtyFlg ID T) (* Reset the type in case of recursive calls change the
type. Always want the highest level type in a recursive
descent)
(NC.SetType ID NoteCardType) (* Insure that a link ptr is set up during the first
save)
(NC.SetLinksDirtyFlg ID T)
(NC.SetPropListDirtyFlg ID T)))))
(RETURN ReturnValue))))
(NC.CheckTitle
(LAMBDA (ID DatabaseStream) (* rht: " 6-Dec-84 19:01")
(* If card specified by ID has no title, ask the user
for a title.)
(* * rht 11/19/84: Now checks NC.ForceTitlesFlg before griping.)
(* * rht 12/6/84: Now sends ID rather than Window to NC.AssignTitle.)
(PROG (Title (Window (NC.FetchWindow ID)))
(COND
((AND NC.ForceTitlesFlg (OR (NULL (NC.FetchTitle ID))
(EQUAL "Untitled" (NC.FetchTitle ID))))
(NC.PrintMsg Window T "This note card has no title." (CHARACTER 13))
(NC.AssignTitle ID T))
((AND (NULL NC.ForceTitlesFlg)
(NULL (NC.FetchTitle ID)))
(NC.AssignTitle ID NIL "Untitled"))))))
(NC.UpdateRegionData
(LAMBDA (ID DatabaseStream) (* fgh: " 5-Oct-84 20:05")
(WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.UpdateRegionData")
(PROG (Index Ptr Status ActualID NoteCardType Title PropList Region Stream)
(SETQ Stream (NC.CoerceDatabaseStream DatabaseStream "NC.UpdateRegionData"))
(SETQ PtrList (NC.GetPtrs ID Stream))
(SETQ Status (CAR PtrList))
(SETQ Ptr (CADR PtrList))
(COND
((NEQ Status (QUOTE ACTIVE))
(NC.ReportError "NC.UpdateRegionData" (CONCAT ID
" not an active note card on "
(FULLNAME DatabaseStream))))
(T (SETFILEPTR Stream Ptr)
(COND
((NOT (NC.GetIdentifier Stream NC.ItemIdentifier))
(NC.ReportError "NC.UpdateRegionData" (CONCAT ID
"Error in database file -- incorrect item identifier"))))
(SETQ ActualID (READ Stream))
(COND
((NEQ ActualID ID)
(NC.ReportError "NC.UpdateRegionData" (CONCAT
"ID mismatch: Expected ID: "
ID " Found ID: "
ActualID))))
(SETQ NoteCardType (READ Stream))
(READC Stream)
(NC.PutRegion ID Stream)
(RETURN ID)))))))
(NC.LinksLegendReshapeFn
(LAMBDA (Window OldImage OldRegion) (* rht: " 7-Dec-84 12:15")
(* * Called when main window is reshaped. Just redisplays the links legend.)
(REDISPLAYW Window)))
(NC.MakeLinksLegendMenu
(LAMBDA (Win LabelPairs) (* rht: " 7-Dec-84 12:27")
(* * Build a links legend menu and attach to Win)
(PROG (Menu MenuWin PromptWin MainWinPromptInfo)
(SETQ Menu (COND
(NC.LinkDashingInBrowser (create MENU
ITEMS ←(for Pair in LabelPairs
join (LIST (CAR Pair)
(LIST (QUOTE " "))))
TITLE ←(QUOTE Links)
MENUCOLUMNS ← 2))
(T (create MENU
ITEMS ←(for Pair in LabelPairs collect (CAR Pair))
TITLE ←(QUOTE Links)
MENUCOLUMNS ← 1))))
(SETQ MenuWin (MENUWINDOW Menu))
(WINDOWADDPROP MenuWin (QUOTE REPAINTFN)
(QUOTE NC.LinksLegendRepaintFn))
(WINDOWADDPROP MenuWin (QUOTE RESHAPEFN)
(QUOTE NC.LinksLegendReshapeFn))
(WINDOWPROP Win (QUOTE NCLABELPAIRS)
LabelPairs) (* Detach the prompt window for a second, saving the
prompt window info from the main win's props.)
(if (SETQ PromptWin (GETPROMPTWINDOW Win NIL NIL T))
then (SETQ MainWinPromptInfo (WINDOWPROP Win (QUOTE PROMPTWINDOW)))
(DETACHWINDOW PromptWin)) (* Stick the links legend window at lower right
corner.)
(ATTACHWINDOW MenuWin Win (QUOTE RIGHT)
(QUOTE TOP)
(QUOTE LOCALCLOSE)) (* Put back the prompt window if it exists.)
(if PromptWin
then (ATTACHWINDOW PromptWin Win (QUOTE TOP)
(QUOTE LEFT)
(QUOTE HERE))
(WINDOWPROP Win (QUOTE PROMPTWINDOW)
MainWinPromptInfo)) (* These CLOSEFNs added to get around a problem with
ATTACHEDWINDOW package.)
(for AttachedWin in (ATTACHEDWINDOWS Win) do (WINDOWADDPROP AttachedWin (QUOTE CLOSEFN)
(QUOTE DETACHWINDOW)))
(OPENW MenuWin)
(MOVEW Win (MAKEWITHINREGION (WINDOWREGION Win)
WHOLESCREEN))
(AND NC.LinkDashingInBrowser (NC.LinksLegendRepaintFn MenuWin NIL))
NIL)))
(NC.BringUpBrowserCard
(LAMBDA (ID Substance Region/Position) (* rht: " 7-Dec-84 11: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.)
(PROG (Window)
(SETQ Window (NC.BringUpGraphCard ID Substance Region/Position))
(NC.MakeLinksLegendMenu Window (LISTGET (NC.RetrievePropList ID)
(QUOTE BrowserLinksLegend)))
(RETURN Window))))
(NC.PlaceMarkerDisplayFn
(LAMBDA (ImageObj Stream) (* rht: " 7-Dec-84 19:33")
(* * rht 9/24/84: Now works for press and interpress as well as screen.)
(PROG ((Label (IMAGEOBJPROP ImageObj (QUOTE OBJECTDATUM)))
(Scale (DSPSCALE NIL Stream))
(Font (FONTCREATE (QUOTE HELVETICA)
12
(QUOTE ITALIC)
NIL Stream)))
(RELMOVETO (ITIMES Scale 3)
0 Stream)
(DSPFONT (PROG1 (DSPFONT Font Stream)
(PRIN1 (U-CASE Label)
Stream))
Stream))))
(NC.PlaceMarkerImageBoxFn
(LAMBDA (ImageObj Stream) (* rht: " 7-Dec-84 19:33")
(* * rht 9/24/84: Now scales the box dimensions so can go to press and interpress.)
(PROG ((Font (FONTCREATE (QUOTE HELVETICA)
12
(QUOTE ITALIC)
NIL Stream))
(Label (IMAGEOBJPROP ImageObj (QUOTE OBJECTDATUM)))
(Scale (DSPSCALE NIL Stream)))
(RETURN (create IMAGEBOX
XSIZE ←(IPLUS (TIMES 6 Scale)
(STRINGWIDTH (U-CASE Label)
Font))
YSIZE ←(IPLUS (TIMES 18 Scale)
(FONTPROP Font (QUOTE HEIGHT)))
YDESC ←(IPLUS (TIMES 3 Scale)
(FONTPROP Font (QUOTE DESCENT)))
XKERN ← 0)))))
(NC.InsertLinkBeforeMarker
(LAMBDA (SourceID DestinationID LinkLabel DisplayMode Marker# DatabaseStream NoSpacerFlg)
(* rht: " 7-Dec-84 20:06")
(* Insert a link to DestinationID in SourceID just
before the Marker#'th place marker object)
(* * rht 12/7/84: Now returns the newly created link.)
(PROG (Objects TextStream TextObject SEL InsertCharPtr (Spacer (CONCAT (CHARACTER 13)))
Link)
(COND
((NC.ActiveCardP SourceID)
(SETQ TextStream (NC.FetchSubstance SourceID))
(SETQ TextObject (TEXTOBJ TextStream))
(COND
((AND (SETQ Objects (TEDIT.LIST.OF.OBJECTS TextObject (FUNCTION NC.PlaceMarkerP)))
(FIXP Marker#))
(COND
((EQ Marker# 0)
(TEDIT.SETSEL TextStream 1 0 (QUOTE LEFT)))
((IGREATERP Marker# (FLENGTH Objects))
(TEDIT.SETSEL TextStream (GETEOFPTR TextStream)
0
(QUOTE RIGHT)))
(T (TEDIT.SETSEL TextStream (CADAR (FNTH Objects Marker#))
0
(QUOTE LEFT)))))
(NC.MarkersInFileBoxesFlg (TEDIT.SETSEL TextStream (GETEOFPTR TextStream)
0
(QUOTE RIGHT))))
(SETQ SEL (fetch (TEXTOBJ SEL) of TextObject))
(SETQ Link (NC.InsertLinkInText TextStream LinkLabel DestinationID SourceID DisplayMode)
)
(COND
((NULL NoSpacerFlg)
(TEDIT.SETSEL TextStream (SELECTQ (fetch (SELECTION POINT) of SEL)
(LEFT (SUB1 (fetch (SELECTION CH#) of SEL)))
(RIGHT (IMIN (ADD1 (fetch (TEXTOBJ TEXTLEN)
of TextObject))
(ADD1 (fetch (SELECTION CHLIM)
of SEL))))
NIL)
0
(QUOTE RIGHT))
(TEDIT.INSERT TextStream Spacer))))
(T (WITH.MONITOR (NC.FetchMonitor DatabaseStream)
(COND
((NC.IDP (NC.GetNoteCard SourceID DatabaseStream))
(SETQ TextStream (NC.FetchSubstance SourceID))
(SETQ TextObject (TEXTOBJ TextStream))
(COND
((AND (SETQ Objects (TEDIT.LIST.OF.OBJECTS TextObject
(FUNCTION
NC.PlaceMarkerP)))
(FIXP Marker#))
(COND
((EQ Marker# 0)
(TEDIT.SETSEL TextStream 1 0 (QUOTE LEFT)))
((IGREATERP Marker# (FLENGTH Objects))
(TEDIT.SETSEL TextStream (GETEOFPTR TextStream)
0
(QUOTE RIGHT)))
(T (TEDIT.SETSEL TextStream (CADAR (FNTH Objects Marker#))
0
(QUOTE LEFT)))))
(NC.MarkersInFileBoxesFlg (TEDIT.SETSEL TextStream (GETEOFPTR
TextStream)
0
(QUOTE RIGHT))))
(SETQ SEL (fetch (TEXTOBJ SEL) of TextObject))
(SETQ Link (NC.InsertLinkInText TextStream LinkLabel DestinationID
SourceID DisplayMode))
(COND
((NULL NoSpacerFlg)
(TEDIT.SETSEL TextStream
(SELECTQ (fetch (SELECTION POINT) of SEL)
(LEFT (SUB1 (fetch (SELECTION CH#)
of SEL)))
(RIGHT (IMIN (ADD1 (fetch (TEXTOBJ
TEXTLEN)
of TextObject))
(ADD1 (fetch (SELECTION
CHLIM)
of SEL))))
NIL)
0
(QUOTE RIGHT))
(TEDIT.INSERT TextStream Spacer)))
(NC.PutNoteCard SourceID DatabaseStream)
(NC.PutLinks SourceID DatabaseStream)
(NC.DeactivateCard SourceID))))))
(RETURN Link))))
(NC.MakeChildLink
(LAMBDA (ChildID ParentID Window) (* rht: " 7-Dec-84 20:09")
(* * Tries to add ChildID as a child of ParentID using either FiledCard or SubBox link as appropriate.
Won't allow if would cause a cycle. Returns new link if successful, else NIL.)
(COND
((for Link in (NC.FetchToLinks ParentID) thereis (AND (NC.ChildLinkP Link)
(EQ ChildID (fetch (NOTECARDLINK
DESTINATIONID)
of Link))))
(NC.PrintMsg Window NIL (NC.RetrieveTitle ChildID PSA.Database)
" is already a child of "
(NC.RetrieveTitle ParentID PSA.Database)
(CHARACTER 13))
NIL)
((AND (NEQ ParentID ChildID)
(NC.NotDaughterP ChildID ParentID (FUNCTION NC.ChildLinkP)))
(NC.MakeAContentsHook ParentID ChildID (if (EQ (NC.FetchType ChildID)
(QUOTE FileBox))
then (QUOTE Sub))
PSA.Database))
(T (NC.PrintMsg Window T (NC.RetrieveTitle ChildID PSA.Database)
" is an ancestor of "
(NC.RetrieveTitle ParentID PSA.Database)
(CHARACTER 13))
NIL))))
(NC.FileBoxCollectChildren
(LAMBDA (WindowOrTextStream ID NewChildren NoDisplayFlg) (* rht: " 7-Dec-84 20:19")
(* * Ask user for new children (either cards or fileboxes) for this filebox. Check to make sure that no
circularities are introduced. This code is sort of the inverse of the NC.AddParents code and thus looks quite
similar.)
(* * rht 10/29/84: Added NoDisplayFlg to prevent error message when no appropriate elements exist.
Also now returns ID if at least one child was added, NIL otherwise.)
(PROG (Window ReturnVal)
(COND
(WindowOrTextStream (SETQ Window (WINDOW.FROM.TEDIT.THING WindowOrTextStream))))
(OR ID (SETQ ID (NC.IDFromWindow Window)))
(COND
(NewChildren)
(T (NC.PrintMsg Window T " Please select new children." (CHARACTER 13))
(SETQ NewChildren (NC.SelectNoteCards NIL NIL NC.SelectingFileBoxChildrenMenu ID))))
(if (NULL (AND NewChildren ID (for NewChildID in NewChildren bind OneHook
when (NC.MakeChildLink NewChildID ID Window)
do (SETQ OneHook T) finally (RETURN OneHook))))
then (OR NoDisplayFlg (NC.PrintMsg Window NIL
"No appropriate NoteCards or FileBoxes chosen."
(CHARACTER 13)
"Hence no children added."
(CHARACTER 13)))
(SETQ ReturnVal NIL)
else (SETQ ReturnVal ID))
(AND Window (GETPROMPTWINDOW Window NIL NIL T)
(PROG1 (DISMISS 1000)
(NC.ClearMsg Window T)))
(RETURN ReturnVal))))
(NC.MakeContentsHooks
(LAMBDA (ID DatabaseStream) (* rht: " 8-Dec-84 16:49")
(* Hooks card specified by ID to all of the current
contents cards by a Contents link)
(* * rht 8/1/84: Changed the NC.PrintMsg2 call for "No FileBox has been specified." to use NIL as second arg rather
than T. This prevents erasure of previous error messages.)
(* * rht 12/8/84: Massive rewrite. Now calls NC.MakeChildLink. And always orphanizes if no parent specified.
This is because it's currently called only by NC.InsureProperFiling.)
(PROG (OneHook (Window (NC.FetchWindow ID))
NewParents)
(NC.PrintMsg Window NIL "Please select the Boxes to file this card in." (CHARACTER 13)
"NoBox files it in the ToBeFiled box."
(CHARACTER 13))
(SETQ NewParents (NC.SelectNoteCards NIL (QUOTE NC.ContentsCardP)
NC.SelectingContentsMenu ID))
(if (NULL (AND NewParents (for ParentID in NewParents bind OneHook
when (NC.MakeChildLink ID ParentID Window) do (SETQ OneHook T)
finally (RETURN OneHook))))
then (NC.PrintMsg Window NIL "No FileBox has been specified." (CHARACTER 13)
"This card will be filed in the ToBeFiled Box."
(CHARACTER 13))
(NC.HookToOrphanCard ID NC.UnclassifiedID DatabaseStream NIL))
(COND
((GETPROMPTWINDOW Window NIL NIL T)
(SPAWN.MOUSE)
(DISMISS 2000)
(NC.ClearMsg Window T))))))
(NC.CheckContentsHooks
(LAMBDA (ID DatabaseStream) (* rht: " 9-Dec-84 18:48")
(* Check to make sure this card has a contents hook of
some sort. If not, hook it up to a contents card.)
(* * rht 12/8/84: Now checks whether both cards *and* fileboxes have been filed.)
(* * rht 12/9/84: Now files in orphan filebox if NC.ForceFiling flag is off, without bothering the user.)
(COND
((AND (NOT (FMEMB ID NC.TopLevelCards))
(for Link in (NC.FetchFromLinks ID) never (FMEMB (fetch (NOTECARDLINK LINKLABEL)
of Link)
(QUOTE (FiledCard SubBox)))))
(if NC.ForceFilingFlg
then (NC.PrintMsg (NC.FetchWindow ID)
T "This card is not currently filed in a FileBox." (CHARACTER 13))
(NC.MakeContentsHooks ID DatabaseStream)
else (NC.PrintMsg (NC.FetchWindow ID)
T "This card is not currently filed in a FileBox." (CHARACTER 13)
"It is being filed in the Orphan FileBox.")
(NC.HookToOrphanCard ID NC.OrphanID DatabaseStream))))))
(NC.AddParents
(LAMBDA (WindowOrTextStream) (* rht: " 8-Dec-84 16:59")
(* Add a subtopic link from a contents card specified by the user to the contents card specified by
WindowOrTextStream. But first check to make sure that this would not introduce any circularities in the contents
lattice.)
(* * rht 12/8/84: Massive shaving. Now calls NC.MakeChildLink to do the tough work.)
(PROG (ID NewParents (Window (WINDOW.FROM.TEDIT.THING WindowOrTextStream)))
(SETQ ID (NC.IDFromWindow Window))
(NC.PrintMsg Window T " Please select the new parent FileBox(es)." (CHARACTER 13))
(SETQ NewParents (NC.SelectNoteCards NIL (FUNCTION NC.ContentsCardP)
NC.SelectingParentsMenu ID))
(if (NULL (AND NewParents ID (for ParentID in NewParents bind OneHook
when (NC.MakeChildLink ID ParentID Window)
do (SETQ OneHook T) finally (RETURN OneHook))))
then (NC.PrintMsg Window NIL "No appropriate FileBoxes chosen." (CHARACTER 13)
"Hence no parents added."
(CHARACTER 13)))
(AND (GETPROMPTWINDOW Window NIL NIL T)
(PROG1 (DISMISS 5000)
(NC.ClearMsg Window T))))))
(NC.MakeTEditLeftMenu
(LAMBDA (NoteCardType) (* rht: " 8-Dec-84 17:09")
(* * Make the LeftButton TEdit menu appropriate for this type of text card. If menu doesn't exist, then make it.)
(* * rht 8/1/84: Added a new menu item for the CONTENTS menu called Collect Children)
(* * rht 9/17/84: (actually redoing earlier changes which got trashed) Added menu item for the CONTENTS menu called
Make Document.)
(* * rht 9/20/84: New menu item for TEXT menu called "Insert Spreadsheet".)
(* * rht 9/25/84: Made MakeDocument also present in TEXT menu.)
(* * rht 12/8/84: Now both fileboxes and notecards do filing via NC.AddParents. Also took out all the strange uses
of NC.TEditMenus.)
(\TEDIT.CREATEMENU (COND
((NEQ NoteCardType (QUOTE FileBox))
(QUOTE ((Show/Edit% Properties (FUNCTION NC.EditProperties)
"Brings up an editor for the property list of this card."
(SUBITEMS (Edit% Property% List
(FUNCTION NC.EditProperties)
"Brings up an editor for the property list of this card.")
(Show% Links
(FUNCTION NC.ShowPointers)
"Brings up a list of the links to and from this card.")))
(Title/Sources/FileBoxes (FUNCTION (LAMBDA (TextStream)
(NC.AssignTitle TextStream)
(NC.AssignSources TextStream)
(NC.FileNoteCard TextStream)))
"Do all of the operations necessary to file this note card in a file box."
(SUBITEMS (Assign% Title
(FUNCTION NC.AssignTitle)
"Assigns a (new) title to this note card.")
(Designate% Sources
(FUNCTION NC.AssignSources)
"Designate the source(s) of the information in this card.")
(File% in% FileBoxes
(FUNCTION NC.AddParents)
"File this note card in one or more file boxes.")
(Unfile% from% FileBoxes
(FUNCTION NC.UnfileNoteCard)
"Remove this card from one or more of its file boxes.")
(Delete% Source
(FUNCTION NC.DeleteSource)
"Delete one of the sources of this card.")))
(Insert% Link (FUNCTION NC.AddLinkToTextCard)
"Insert a link to another card at the currently selected point in the text."
(SUBITEMS (Insert% Link (FUNCTION
NC.AddLinkToTextCard)
"Insert a link to another card at the currently selected point in the text.")
(Insert% Links (FUNCTION
NC.AddLinksToTextCard)
"Insert links to other cards at the currently selected point in the text.")))
(Close% and% Save (FUNCTION NC.QuitCard)
"Close this note card after saving it in the NoteFile."
(SUBITEMS (Close% and% Save
(FUNCTION NC.TEditCloseFn)
"Close this note card after saving it in the NoteFile.")
(Close% w/o% Saving
(FUNCTION NC.QuitWithoutSaving)
"Close this note card without saving any changes made since the last Save.")
(Save% in% NoteFile
(FUNCTION NC.TEditSaveFn)
"Save this card in the NoteFile but don't close the card.")
(Delete% Card (FUNCTION
NC.DeleteNoteCards)
"Permenantly delete this card from the NoteFile.")))))
)
(T (QUOTE ((Show/Edit% Properties (FUNCTION NC.EditProperties)
"Brings up an editor for the property list of this card."
(SUBITEMS (Edit% Property% List
(FUNCTION NC.EditProperties)
"Brings up an editor for the property list of this card.")
(Show% Links
(FUNCTION NC.ShowPointers)
"Brings up a list of the links to and from this card.")))
(Put% in% FileBox (FUNCTION NC.AddParents)
"Put this FileBox in new parent FileBox(es).")
(Assign% Title (FUNCTION NC.AssignTitle)
"Assign a new title to this FileBox.")
(Collect% Children (FUNCTION NC.FileBoxCollectChildren)
"Collect new child cards and file boxes for this FileBox.")
(Close% and% Save (FUNCTION NC.TEditCloseFn)
"Close this note card after saving it in the NoteFile."
(SUBITEMS (Close% and% Save
(FUNCTION NC.TEditCloseFn)
"Close this note card after saving it in the NoteFile.")
(Save% in% NoteFile
(FUNCTION NC.TEditSaveFn)
"Save this card in the NoteFile but don't close the card.")
(Delete% FileBox
(FUNCTION NC.DeleteNoteCards)
"Permenantly delete this FileBox from the NoteFile.")))))
)))))
(NC.InsureProperFiling
(LAMBDA (ID DatabaseStream) (* rht: " 9-Dec-84 18:40")
(* Called when any type of note card is being quitted
from, i.e., closed)
(* * rht 12/9/84: Moved check of the NC.ForceFiling flag into NC.CheckContentsHooks.)
(COND
((NULL (NC.FetchBeingDeletedFlg ID))
(NC.CheckTitle ID DatabaseStream)
(AND NC.ForceSourcesFlg (NC.CheckSources ID DatabaseStream))
(NC.CheckContentsHooks ID DatabaseStream)))))
)
(RPAQ NC.FileBoxIcon (READBITMAP))
(21 18
"OOOOOH@@"
"OOOOOH@@"
"OOOOOH@@"
"H@@@@H@@"
"H@@@@H@@"
"H@B@@H@@"
"H@@@@H@@"
"OOOOOH@@"
"H@@@@H@@"
"H@@@@H@@"
"H@B@@H@@"
"H@@@@H@@"
"OOOOOH@@"
"H@@@@H@@"
"H@@@@H@@"
"H@B@@H@@"
"H@@@@H@@"
"OOOOOH@@")
(RPAQ NC.GraphCardIcon (READBITMAP))
(21 18
"OOOOOH@@"
"H@@@@H@@"
"H@@@@H@@"
"H@N@@H@@"
"H@J@@H@@"
"HAJ@@H@@"
"HBO@@H@@"
"HD@KHH@@"
"KH@FHH@@"
"JH@BHH@@"
"JH@CHH@@"
"KL@@@H@@"
"HBN@@H@@"
"HAJ@@H@@"
"H@J@@H@@"
"H@N@@H@@"
"H@@@@H@@"
"OOOOOH@@")
(RPAQ NC.SketchCardIcon (READBITMAP))
(21 18
"OOOOOH@@"
"H@@@@H@@"
"HGO@@H@@"
"HH@H@H@@"
"H@@G@H@@"
"HC@@HH@@"
"HDH@DH@@"
"HHD@BH@@"
"I@B@@H@@"
"I@B@@H@@"
"HHDONH@@"
"HDHHBH@@"
"HC@HBH@@"
"H@@HBH@@"
"H@@HBH@@"
"H@@ONH@@"
"H@@@@H@@"
"OOOOOH@@")
(RPAQ NC.TextCardIcon (READBITMAP))
(21 18
"OOOOOH@@"
"OOOOOH@@"
"OOOOOH@@"
"OOOOOH@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"H@@@@H@@"
"OOOOOH@@")
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.FileBoxIcon NC.GraphCardIcon NC.SketchCardIcon NC.TextCardIcon)
)
(PUTPROPS RHTPATCH005 COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1499 41591 (NC.LinkIconDisplayFn 1509 . 6114) (NC.LinkIconImageBoxFn 6116 . 8825) (
NC.GetTypeIcon 8827 . 9164) (NC.InsertLinkBeforeMarker 9166 . 13055) (NC.MakeContentsCard 13057 .
15676) (NC.MakeNoteCard 15678 . 17860) (NC.CheckTitle 17862 . 18746) (NC.UpdateRegionData 18748 .
20140) (NC.LinksLegendReshapeFn 20142 . 20386) (NC.MakeLinksLegendMenu 20388 . 22721) (
NC.BringUpBrowserCard 22723 . 23277) (NC.PlaceMarkerDisplayFn 23279 . 23898) (NC.PlaceMarkerImageBoxFn
23900 . 24686) (NC.InsertLinkBeforeMarker 24688 . 28577) (NC.MakeChildLink 28579 . 29815) (
NC.FileBoxCollectChildren 29817 . 31520) (NC.MakeContentsHooks 31522 . 33233) (NC.CheckContentsHooks
33235 . 34472) (NC.AddParents 34474 . 35838) (NC.MakeTEditLeftMenu 35840 . 40985) (
NC.InsureProperFiling 40987 . 41589)))))
STOP