(FILECREATED "30-May-86 11:19:44" {QV}<NOTECARDS>1.2K>KOTOPOSTRELEASEPATCHES.;7 10914
changes to: (VARS KOTOPOSTRELEASEPATCHESCOMS)
previous date: "30-May-86 08:51:45" {QV}<NOTECARDS>1.2K>KOTOPOSTRELEASEPATCHES.;6)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT KOTOPOSTRELEASEPATCHESCOMS)
(RPAQQ KOTOPOSTRELEASEPATCHESCOMS ((* * fgh 2/19/86 changed READC/PEEKC to BIN/PEEKBIN calls to
avoid problems with NS characters in Koto and beyond.)
(FNS NC.SkipWhiteSpace)
(* * fgh 2/19/86 Adapts to changes in Sketch interface)
(FNS NC.MakeSketchCard)
(* * fgh 3/27/86 Fix to moving icons in sketches from Newman &
Marshall)
(FNS NC.LinkIconWhenMovedFn)
(* * kirk 30Apr86 RHTPATCH005 changes)
(FNS NCP.SelectCards NC.ClearMsg)))
(* * fgh 2/19/86 changed READC/PEEKC to BIN/PEEKBIN calls to avoid problems with NS characters
in Koto and beyond.)
(DEFINEQ
(NC.SkipWhiteSpace
(LAMBDA (Stream EofPtr SkipNullsFlg) (* fgh: "19-Feb-86 12:34")
(* * Skip over all separator characters. There seem to be nulls at the end of the file sometimes
(char code = 0) so SkipNullsFlg = T calls them white space.)
(* * fgh 2/19/86 Replaced READC/PEEKC with BIN/PEEKBIN to avoid problems with NS characters in Koto and beyond.)
(LET ((CurPtr (GETFILEPTR Stream))
(SeprChars (GETSEPR)))
(OR EofPtr (SETQ EofPtr (GETEOFPTR Stream)))
(if SkipNullsFlg
then (SETQ SeprChars (CONS 0 SeprChars)))
(for Ptr from CurPtr while (AND (LESSP Ptr EofPtr)
(FMEMB (\PEEKBIN Stream)
SeprChars))
do (BIN Stream)))))
)
(* * fgh 2/19/86 Adapts to changes in Sketch interface)
(DEFINEQ
(NC.MakeSketchCard
(LAMBDA (ID Title NoDisplayFlg) (* fgh: "19-Feb-86 12:44")
(* * rht 2/1/85: Added windowprop to prevent sketch asking about saving changes.)
(COND
(NoDisplayFlg (NC.SetSubstance ID NIL)
ID)
(T (PROG (Window)
(SETQ Window (SKETCHW.CREATE NIL NIL (NC.DetermineDisplayRegion ID NIL)
(OR Title "Untitled")))
(WINDOWPROP Window (QUOTE DONTQUERYCHANGES)
T)
(WINDOWPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.SketchCardShrinkFn))
(NC.SetupTitleBarMenu Window ID (QUOTE Sketch))
(NC.SetSubstance ID (INSURE.SKETCH Window))
(RETURN Window))))))
)
(* * fgh 3/27/86 Fix to moving icons in sketches from Newman & Marshall)
(DEFINEQ
(NC.LinkIconWhenMovedFn
[LAMBDA (ImageObject ToWindowStream FromTextStream ToTextStream)
(* Newman "20-Mar-86 13:23")
(* * Called when moving a link icon from FromTextStream to ToWindowStream. Sets the necessary link information up
for card corresponding to ToWindowStream.)
(* * rht 11/18/84: Major hacking. Now checks for all sorts of illegal cases. Either goes ahead with move, converts
link type to "Unspecified", or deletes the new "invisible" link. The code is very similar to
NC.LinkIconWhenCopiedFn except that within-filebox moves are allowed. Also when aborting a move, we must insert a
copy of the link back to take the place of the deleted original. This will all change when imageobj fns can return
DON'T.)
(* * rht 12/12/84: Now just RETFROM's rather than doing the addprocess stuff. Should be cleaner, but still ugly.)
(* * Newman "20-Mar-86 13:17" With CCM fixed multiple link in sketch card.)
(PROG (Label (Link (NC.FetchLinkFromLinkIcon ImageObject))
SourceID DestID NewSourceID NewLabel NewDisplayMode OldDisplayMode
(Window (AND ToWindowStream (WFROMDS ToWindowStream T)))
InsertPos)
(SETQ Label (fetch (NOTECARDLINK LINKLABEL) of Link))
[SETQ NewSourceID (COND
((WINDOWP Window)
(NC.IDFromWindow Window))
((TEXTSTREAMP ToTextStream)
(NC.CoerceToID ToTextStream]
(SETQ SourceID (fetch (NOTECARDLINK SOURCEID) of Link))
(SETQ DestID (fetch (NOTECARDLINK DESTINATIONID) of Link))
(SETQ OldDisplayMode (fetch (NOTECARDLINK DISPLAYMODE) of Link))
[COND
((AND (NULL FromTextStream)
(NULL ToTextStream)) (* We must be moving within a sketch.)
(SETQ NewSourceID SourceID))
((TEXTSTREAMP ToTextStream) (* If it's a text copy, then compute position to
insert link at.)
(SETQ InsertPos (NC.CharPosFromTextObject (TEXTOBJ ToTextStream]
[COND
((NULL NewSourceID) (* Trying to copy to a non NoteCard stream)
(NC.PrintMsg Window NIL (CONCAT "Tried to move a NoteCards link icon"
" to a non-NoteCards stream!!."
(CHARACTER 13)
"Tsk. Tsk."
(CHARACTER 13)))
(RETFROM (QUOTE TEDIT.MOVE)
NIL T))
([NULL (NC.LinksSupportedP NewSourceID (QUOTE (Local]
(NC.PrintMsg Window NIL (CONCAT "Tried to move a NoteCards link icon"
" to a NoteCard that"
" does not support links!!."
(CHARACTER 13)
"Tsk. Tsk."
(CHARACTER 13)))
(RETFROM (QUOTE TEDIT.MOVE)
NIL T))
((AND (FMEMB Label (QUOTE (FiledCard SubBox)))
(NEQ (NC.FetchType NewSourceID)
(QUOTE FileBox))) (* Move from filebox to non-filebox.)
(NC.PrintMsg NIL NIL (CONCAT
"Tried to move filedcard or subbox link to a non-filebox."
(CHARACTER 13)
"Link type of copy set to 'Unspecified'."
(CHARACTER 13)))
(SETQ NewLabel NC.UnspecifiedLinkLabel)
(SETQ NewDisplayMode (create LINKDISPLAYMODE
copying OldDisplayMode SHOWTITLEFLG ← T SHOWLINKTYPEFLG ←
T)))
((AND (NEQ (NC.FetchType SourceID)
(QUOTE FileBox))
(EQ (NC.FetchType NewSourceID)
(QUOTE FileBox))) (* Move from non-filebox to filebox.)
(NC.PrintMsg NIL NIL (CONCAT "Can't move links from non-filebox to filebox."
(CHARACTER 13)
"Try using PutCardsHere."
(CHARACTER 13)))
(RETFROM (QUOTE TEDIT.MOVE)
NIL T))
([AND (EQ (NC.FetchType NewSourceID)
(QUOTE FileBox))
(NEQ NewSourceID SourceID)
(for Link1 in (NC.FetchToLinks NewSourceID)
thereis (AND (NC.ChildLinkP Link1)
(EQ DestID (fetch (NOTECARDLINK DESTINATIONID)
of Link1]
(* Move to a filebox already containing this child.)
(NC.PrintMsg NIL NIL (CONCAT (NC.RetrieveTitle DestID PSA.Database)
" not moved: already appears as a child of "
(NC.RetrieveTitle NewSourceID PSA.Database)
(CHARACTER 13)))
(RETFROM (QUOTE TEDIT.MOVE)
NIL T))
([AND (EQ Label (QUOTE SubBox))
(NEQ NewSourceID SourceID)
(OR (EQ NewSourceID DestID)
(NOT (NC.NotDaughterP DestID NewSourceID (FUNCTION NC.ChildLinkP]
(* Move to a filebox causes a cycle.)
(NC.PrintMsg NIL NIL (CONCAT "Couldn't move " Link " because of subbox cycle."
(CHARACTER 13)))
(RETFROM (QUOTE TEDIT.MOVE)
NIL T))
((AND (FMEMB Label NC.SystemLinkLabels)
[NOT (FMEMB Label (QUOTE (FiledCard SubBox]
(NEQ NewSourceID SourceID)) (* Move of system link outside of own card.)
(NC.PrintMsg NIL NIL (CONCAT "Tried to copy system link." (CHARACTER 13)
"Link type of copy set to 'Unspecified'."
(CHARACTER 13)))
(SETQ NewLabel NC.UnspecifiedLinkLabel)
(SETQ NewDisplayMode (create LINKDISPLAYMODE
copying OldDisplayMode SHOWTITLEFLG ← T SHOWLINKTYPEFLG ←
T]
(IMAGEOBJPROP ImageObject (QUOTE LinkBeingMoved)
Link)
(* * Here one must check to see if the source card of the link being moved is a Sketch If so, we do nothing.
This corrects the bug where extra links were created as a result of moving a link within a sketch or copying a link
within a sketch. Dave Newman and Cathy Marshall fixed this here bug.)
(COND
((NOT (EQUAL (QUOTE Sketch)
(NCP.CardType SourceID)))
(NC.FillInLinkIcon ImageObject (OR NewLabel Label)
DestID NewSourceID (OR NewDisplayMode OldDisplayMode)
(NC.LinkAtCharPos InsertPos ToTextStream])
)
(* * kirk 30Apr86 RHTPATCH005 changes)
(DEFINEQ
(NCP.SelectCards
(LAMBDA (IDOrWindow SingleCardFlg SelectionPredicate Msg CheckForCancelFlg)
(* rht: " 7-Nov-85 19:14")
(* * Return a list of cards selected. A menu pops up near the prompt window with "DONE" and "CANCEL" buttons.
User selects by clicking in card's title bar.)
(* * rht 11/7/85: Now takes a bunch of arguments that NC.SelectNoteCards wants. Only ones left out are Menu and
ReturnLinksFlg.)
(NC.SelectNoteCards SingleCardFlg SelectionPredicate NC.SelectingCardsMenu IDOrWindow NIL Msg
CheckForCancelFlg)))
(NC.ClearMsg
(LAMBDA (MainWindow ClosePromptWindowFlg) (* rht: " 7-Nov-85 19:17")
(* Clear and optionally close the promnpt window for
MainWindow)
(* * rht 9/10/85: Fixed so closes instead of removing prompt window and clears whether prompt win gets closed or
not.)
(* * rht 11/7/85: Now checks if MainWindow is a NC window. If so, clears its promptwindow. If not, clears
MainWindow itself.)
(LET (PromptWindow)
(if (WINDOWP MainWindow)
then (if (NC.IDFromWindow MainWindow)
then (CLEARW (SETQ PromptWindow (GETPROMPTWINDOW MainWindow)))
(if ClosePromptWindowFlg
then (CLOSEW PromptWindow))
else (CLEARW MainWindow))
else (CLRPROMPT)))))
)
(PUTPROPS KOTOPOSTRELEASEPATCHES COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (986 1828 (NC.SkipWhiteSpace 996 . 1826)) (1891 2687 (NC.MakeSketchCard 1901 . 2685)) (
2767 9196 (NC.LinkIconWhenMovedFn 2777 . 9194)) (9242 10821 (NCP.SelectCards 9252 . 9906) (NC.ClearMsg
9908 . 10819)))))
STOP