(FILECREATED " 5-Dec-84 18:19:06" {PHYLUM}<PSA>NOTECARDS>RELEASE1.1>RHTPATCH005.;2 17372
changes to: (VARS RHTPATCH005COMS NC.SketchCardIcon NC.GraphCardIcon NC.FileBoxIcon
NC.TextCardIcon)
(FNS NC.LinkIconDisplayFn NC.InsertLinkBeforeMarker NC.MakeContentsCard
NC.LinkIconImageBoxFn 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)
(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: " 5-Dec-84 18:16")
(* * 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 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)))
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.)
(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 (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 (ITIMES Scale (BITMAPWIDTH TypeIcon))
Left))
(SETQ BoxBottom (IPLUS Scale Bottom))
(SETQ BoxWidth (IDIFFERENCE XSize (ITIMES Scale (IPLUS 4 (BITMAPWIDTH TypeIcon)))))
(SETQ BoxHeight (IDIFFERENCE YSize (ITIMES Scale 4)))
(DRAWBOX BoxLeft BoxBottom BoxWidth BoxHeight Scale ImageStream)
(* * Enter the appropriate text.)
(SETQ TextLeft (IPLUS BoxLeft (ITIMES Scale 5)))
(SETQ TextBaseLine (IPLUS Bottom (ITIMES Scale (IPLUS 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: " 4-Dec-84 20:19")
(* * 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 ←(ITIMES Scale
(if (EQ DisplayType (QUOTE Icon))
then (BITMAPWIDTH TypeIcon)
else (IPLUS (BITMAPWIDTH TypeIcon)
(STRINGWIDTH
(CONCAT "nn"
(SELECTQ DisplayType
(SourceTitle Title)
(Title Title)
(Label (CONCAT "<" Label
">"))
(Both (CONCAT "<" Label ">"
" "
Title))
" "))
(SETQ FONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE BOLD)))))))
YSIZE ←(ITIMES Scale (IMAX (BITMAPHEIGHT TypeIcon)
(IPLUS (FONTPROP FONT (QUOTE HEIGHT))
8)))
YDESC ←(COND
(RightMargin (* This is in a TEdittextstream)
(ITIMES Scale (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: " 5-Dec-84 11:54")
(* Insert a link to DestinationID in SourceID just
before the Marker#'th place marker object)
(PROG (Objects TextStream TextObject SEL InsertCharPtr (Spacer (CONCAT (CHARACTER 13))))
(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))
(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))
(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)))))))))
(NC.MakeContentsCard
(LAMBDA (ID Title DontDisplay) (* rht: " 5-Dec-84 11:58")
(* 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.)
(PROG (DatabaseStream Window TextStream ParentIDs (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)) (* Hook up this card to the parents as specified by the
user.)
(SETQ DatabaseStream PSA.Database)
(NC.PrintMsg Window T "Please select parent Box(es)." (CHARACTER 13))
(SETQ ParentIDs (NC.SelectNoteCards NIL NIL NC.SelectingParentsMenu Window))
(* Check to make sure that cards specified are in fact
contents cards.)
(NC.ClearMsg Window T)
(COND
((NULL (SETQ ParentIDs (for ParentID in ParentIDs
when (AND (COND
((EQ ParentID ID)
(NC.PrintMsg Window NIL
"A Box cannot be its own parent."
(CHARACTER 13)
(NC.RetrieveTitle ID)
" ignored."
(CHARACTER 13))
NIL)
(T T))
(OR (COND
((NC.ActiveCardP ParentID)
(EQ (NC.FetchType ParentID)
(QUOTE FileBox)))
(T (WITH.MONITOR (NC.FetchMonitor
DatabaseStream)
(NC.GetNoteCard ParentID
DatabaseStream)
(PROG1 (EQ (NC.FetchType
ParentID)
(QUOTE FileBox))
(NC.DeactivateCard
ParentID)))))
(PROG1 NIL (NC.PrintMsg Window NIL ParentID
" is not a FileBox."
(CHARACTER 13)
"It will not be used as a parent."))))
collect ParentID)))
(NC.PrintMsg Window T "None of the parents specified are FileBoxes." (CHARACTER 13)
"Creating of new FileBox cancelled.")
(DISMISS 1000)
(CLOSEW Window)
(RETURN NIL))) (* 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))
(* hook it up. Must be done after the TEdit window is
open)
(NC.ActivateCard ID)
(for ParentID in ParentIDs do (NC.MakeAContentsHook ParentID ID (QUOTE Sub)
DatabaseStream))
(replace (TEXTOBJ \DIRTY) of (TEXTOBJ TextStream) with T)
(AND (GETPROMPTWINDOW Window NIL NIL T)
(PROG1 (DISMISS 1000)
(NC.ClearMsg Window T)))
(RETURN Window))))
)
(RPAQ NC.FileBoxIcon (READBITMAP))
(21 18
"OOOOOH@@"
"OOOOOH@@"
"OOOOOH@@"
"OOOOOH@@"
"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 (840 16200 (NC.LinkIconDisplayFn 850 . 4893) (NC.LinkIconImageBoxFn 4895 . 7447) (
NC.GetTypeIcon 7449 . 7786) (NC.InsertLinkBeforeMarker 7788 . 11535) (NC.MakeContentsCard 11537 .
16198)))))
STOP