(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED "22-Feb-88 12:08:26" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH311.;1 14910
changes to%: (VARS RHTPATCH311COMS))
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT RHTPATCH311COMS)
(RPAQQ RHTPATCH311COMS ((DECLARE%: DONTCOPY (PROPS (RHTPATCH311 MAKEFILE-ENVIRONMENT)
(RHTPATCH311 FILETYPE)))
(* ;;
"Makes notecard type menu come up at cursor when creating new card from browser or from InsertLink.")
(* ;; "Change to NCLINKS")
(FNS NC.MakeLink)
(* ;; "Change to NCINTERFACE")
(FNS NC.AskNoteCardType)))
(DECLARE%: DONTCOPY
(PUTPROPS RHTPATCH311 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS RHTPATCH311 FILETYPE :TCOMPL)
)
(* ;;
"Makes notecard type menu come up at cursor when creating new card from browser or from InsertLink.")
(* ;; "Change to NCLINKS")
(DEFINEQ
(NC.MakeLink
[LAMBDA (Window LinkLabel DestinationCard SourceCard DisplayMode AnchorMode Message NoDisplayFlg
LinkToInsertAfter CrossFileLinksMode) (* ; "Edited 22-Feb-88 12:03 by Trigg")
(* ;;; "Make a link from (OR Window SourceCard) to DestinationCard with linklabel of LinkLabel")
(* ;;
"rht 1/12/85: If need to create a new card, then now shows card type menu near window of SourceID.")
(* ;; "rht 1/13/85: Added extra args Message and NoDisplayFlg.")
(* ;; "rht 3/26/85: Added LinkToInsertAfter arg which should be NIL or a link to insert the new To link after. If NIL, then insert at front of ToLinks.")
(* ;; "kirk 9/23/85: took out GETPROMPTWINDOW call for asknotecardtype")
(* ;; "kirk: 14Nov85: changed NC.CoerceToID to to NC.CoerceToCard")
(* ;; "fgh 11/16/85 Changed from PROG to LET and used COND to contyrol returnmed value.")
(* ;; "fgh 2/5/86 Changed call DefaultLinkDisplayMode to FetchLinkDisplayMode")
(* ;; "fgh 6/5/86 Now calls AskLinkLabel if LinkLabel arg is NIL")
(* ;; "rht 7/4/86: Added check for readonly card.")
(* ;;
"kef 7/17/86: Added calls to grab the write permission on the appropriate card parts.")
(* ;; "kef 7/22/86: Saves the links on the Destination Card now right away, while still holding onto the FROMLINKS write lock.")
(* ;; "fgh 8/30/86 Adpated to use NC.IfCardPartNotBusy.")
(* ;; "rht 9/29/86: Tossed Ken's call to NC.PutFromLinks; It was the cause of too many nasty breaks. Also made syntactic fixes.")
(* ;; "rht 10/4/86: Now handles cross file links. New arg CrossFileLinksMode determines whether cross-file link will be two-way, i.e. will destination card know it's being linked to.")
(* ;; "rht 11/10/86: Now creates new crossfile link if Destination card is a CrossFileLink card that we didn't just create.")
(* ;;
"rht 11/14/86: Now checks if non-nil DestinationCard before trying to do cross-filelink stuff.")
(* ;; "pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.")
(* ;; "rht 12/9/86: Throws out JustCreatedFlg marker stuff.")
(* ;;
"pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.")
(* ;; "rht 12/16/86: Fixed bug whereby electing not to open notefile containing crossfilelink dest card caused break.")
(* ;; "rht 12/16/86: Now passes Window down to NC.GetCrossFileLinkDestCard.")
(* ;; "rg 3/18/87 added NCP.WithLockedCards wrapper")
(* ;; "rht 5/25/87: No longer tries to make two way cross-file links when dest notefile is open read-only. Also assumes that CrossFileLinksMode is one of TWOWAY, ONEWAY or ASK. Now fills in the new RemoteCrossFileLinkCardUID field of cross file link cards.")
(* ;; "rht 11/20/87: Now recomputes ShowLinks menus if they're visible.")
(* ;; "rht 2/22/88: Now passes NIL argument to NC.AskNoteCardType which makes type selection menu come up at cursorpos.")
(DECLARE (GLOBALVARS NC.SelectingSingleCardMenu NC.NewCrossFileLinksMode))
(OR SourceCard (SETQ SourceCard (NC.CoerceToCard Window)))
(AND
(NC.CheckForNotReadOnly SourceCard Window "Can't make links in ")
(NCP.WithLockedCards
(LET
(Link Type)
(OR Window (SETQ Window (NC.FetchWindow SourceCard)))
(OR Message (SETQ Message "Please shift-select the Card or Box to be linked to."))
(OR LinkLabel (SETQ LinkLabel (NC.AskLinkLabel Window NIL NIL T NIL)))
(OR DestinationCard (SETQ DestinationCard (NC.SelectNoteCards T
[FUNCTION (LAMBDA (Card)
(COND
((NOT (NC.SameCardP Card
SourceCard))
T)
(T (NC.PrintMsg Window T
"A Card/Box cannot link to itself. "
(CHARACTER 13)
"Selection ignored."
(CHARACTER 13))
NIL]
NC.SelectingSingleCardMenu SourceCard Message
)))
[if (EQ DestinationCard '*New% Card*)
then (SETQ DestinationCard (AND (SETQ Type (NC.AskNoteCardType))
(NC.CoerceToCard (NC.MakeNoteCard Type (fetch (Card
NoteFile
)
of SourceCard)
NIL NoDisplayFlg]
(* ;;; "If we're trying to link to a CrossFileLink card, then check whether card was just created. If so, then it's the first link, otherwise we make a new CrossFileLink.")
(AND DestinationCard (NC.CrossFileLinkCardP DestinationCard)
(SETQ DestinationCard (NC.GetCrossFileLinkDestCard DestinationCard Window))
(NC.SetUserDataProp DestinationCard 'JustCreatedFlg NIL))
(if DestinationCard
then
(NC.IfCardPartNotBusy
DestinationCard
'FROMLINKS
(NC.IfCardPartNotBusy
SourceCard
'TOLINKS
(* ;;; "If have cross-file link, then make two new crossfilelink cards, one per notefile. Make global link over there from crossfilelink card to DestinationCard and local link here from SourceCard to crossfilelink card.")
[if (NOT (NC.SameNoteFileP (fetch (Card NoteFile) of SourceCard)
(fetch (Card NoteFile) of DestinationCard)))
then (LET ([CrossFileLinksTwoWayFlg (OR (EQ CrossFileLinksMode 'TWOWAY)
(AND (NULL CrossFileLinksMode)
(EQ NC.NewCrossFileLinksMode
'TWOWAY))
(AND [OR (EQ CrossFileLinksMode 'ASK)
(AND (NULL CrossFileLinksMode)
(EQ NC.NewCrossFileLinksMode
'ASK]
(NC.AskCrossFileLinkMode
DestinationCard Window]
RemoteSourceCard)
(if CrossFileLinksTwoWayFlg
then (AND (SETQ RemoteSourceCard (NC.CreateCrossFileLinkCard
DestinationCard SourceCard T))
(NC.MakeGlobalLink Window LinkLabel DestinationCard
RemoteSourceCard DisplayMode)))
(SETQ DestinationCard (NC.CreateCrossFileLinkCard SourceCard
DestinationCard CrossFileLinksTwoWayFlg))
(if RemoteSourceCard
then (* ;
"Make the two crossfile link cards know about each other's UIDs.")
(replace (CrossFileLinkSubstance RemoteCrossFileLinkCardUID)
of (NC.FetchSubstance RemoteSourceCard)
with (fetch (Card UID) of DestinationCard))
(replace (CrossFileLinkSubstance RemoteCrossFileLinkCardUID)
of (NC.FetchSubstance DestinationCard)
with (fetch (Card UID) of RemoteSourceCard]
[SETQ Link (create Link
UID ← (NC.MakeUID)
SourceCard ← SourceCard
DestinationCard ← DestinationCard
AnchorMode ← AnchorMode
Label ← LinkLabel
DisplayMode ← (OR DisplayMode (NC.FetchLinkDisplayMode SourceCard]
(NC.AddToLink Link LinkToInsertAfter)
(NC.AddFromLink Link) (* ;
"Recompute ShowLinks menus if they're up.")
(if (NC.FetchShowLinksWindow SourceCard)
then (NC.ShowLinks SourceCard))
(if (NC.FetchShowLinksWindow DestinationCard)
then (NC.ShowLinks DestinationCard))
Link))
else NIL])
)
(* ;; "Change to NCINTERFACE")
(DEFINEQ
(NC.AskNoteCardType
[LAMBDA (MainMenuOrRegion) (* ; "Edited 22-Feb-88 12:03 by Trigg")
(* ;
"Ask user to choose a note card type")
(* ;; "rht 1/12/85: Now takes an optional Region argument dictating where to place the NoteCardTypeMenu. If NIL, then uses MainMenu.")
(* ;;
"fgh 11/16/85 Updated to take a MainMenu arg in place of using the NC.MainMenu globalvar.")
(* ;; "pmi 3/20/87: Changed fields of NC.NoteCardTypeMenu: CENTERFLG to T, MENUFONT to NC.MenuFont, changed title from 'Type?' to 'Card Types'")
(* ;; "pmi 12/31/87: Changed ManinMenuOrRegion to MainMenuOrRegion.")
(* ;;
"rht 2/22/88: Now allows NIL MainMenuOrRegion arg which brings up menu at cursor position.")
(DECLARE (GLOBALVARS NC.NoteCardTypeMenu NC.MenuFont))
(PROG (W Z)
[OR (AND (BOUNDP 'NC.NoteCardTypeMenu)
(type? MENU NC.NoteCardTypeMenu))
(SETQ NC.NoteCardTypeMenu (create MENU
ITEMS ← (NC.ListOfCardTypes T)
CENTERFLG ← T
TITLE ← "Card Types"
MENUFONT ← NC.MenuFont
ITEMHEIGHT ← (IPLUS (FONTPROP NC.MenuFont 'HEIGHT)
1]
(replace MENUPOSITION of NC.NoteCardTypeMenu
with (COND
[(REGIONP MainMenuOrRegion)
(CONS (fetch (REGION LEFT) of MainMenuOrRegion)
(IPLUS (fetch (REGION BOTTOM) of MainMenuOrRegion)
(fetch (REGION HEIGHT) of MainMenuOrRegion)
(IMINUS (fetch (MENU IMAGEHEIGHT) of NC.NoteCardTypeMenu]
[(type? MENU MainMenuOrRegion)
(CONS [IPLUS [fetch (REGION LEFT) of (SETQ Z (WINDOWPROP (WFROMMENU
MainMenuOrRegion
)
'REGION]
(fetch (REGION LEFT)
of (SETQ W (MENUITEMREGION (CAR (NTH (fetch (MENU ITEMS)
of MainMenuOrRegion)
1))
MainMenuOrRegion]
(IPLUS (fetch (REGION BOTTOM) of Z)
(fetch (REGION TOP) of W)
(IMINUS (fetch (MENU IMAGEHEIGHT) of NC.NoteCardTypeMenu]
(T NIL)))
(RETURN (MENU NC.NoteCardTypeMenu])
)
(PUTPROPS RHTPATCH311 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1202 11418 (NC.MakeLink 1212 . 11416)) (11458 14827 (NC.AskNoteCardType 11468 . 14825))
)))
STOP