(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED "10-Feb-88 12:15:22" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH310.;1 18937
changes to%: (VARS RHTPATCH310COMS)
(FNS NC.LinkIconWhenMovedFn NC.EditPropList))
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT RHTPATCH310COMS)
(RPAQQ RHTPATCH310COMS (
(* ;;; "New file")
(DECLARE%: DONTCOPY (PROPS (RHTPATCH310 MAKEFILE-ENVIRONMENT)
(RHTPATCH310 FILETYPE)))
(* ;; "Fixes bug reported by John Tang whereby moving multiple linkicons at once within a card screws up ShowLinks ordering. Also prevented cursor from being moved into ShowLinks menu.")
(* ;; "Change to NCLINKS")
(FNS NC.LinkIconWhenMovedFn)
(* ;; "Change to NCCARDS")
(FNS NC.EditPropList)))
(* ;;; "New file")
(DECLARE%: DONTCOPY
(PUTPROPS RHTPATCH310 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS RHTPATCH310 FILETYPE :TCOMPL)
)
(* ;;
"Fixes bug reported by John Tang whereby moving multiple linkicons at once within a card screws up ShowLinks ordering. Also prevented cursor from being moved into ShowLinks menu."
)
(* ;; "Change to NCLINKS")
(DEFINEQ
(NC.LinkIconWhenMovedFn
[LAMBDA (ImageObject ToWindowStream FromTextStream ToTextStream)
(* ; "Edited 10-Feb-88 11:59 by Trigg")
(* ;; "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.")
(* ;; "kirk 15Nov85: deleted use of PSA.Database")
(* ;; "rht 3/24/86: Changed call to NC.CoerceToID to NC.CoerceToCard")
(* ;; "kirk 24Mar86: added Dave Newman patch to avoid duplicate links in sketch cards")
(* ;;
"rht 7/14/86: Reversed order of tests for WINDOWP and TEXTSTREAMP in computation of NewSourceCard.")
(* ;; "rht 8/11/86: Now only resets NewSourceCard if it was NIL so that moves to a sketch will work. Now checks if SourceCard = NewSourceCard in which case we're moving within a card. Don't make a new link in that case.")
(* ;; "rht 10/5/86: Undid change fgh 6/30/86: now allows copies of links across notefiles.")
(* ;; "rht 11/13/86: Removed 'tsk, tsk' messages.")
(* ;; "rht 12/16/86: Fixed calls to NC.PrintMsg to use Window arg.")
(* ;; "rht 1/25/87: Now stashes new link created on source card's user data props for use by NC.LinkAtCharPos in case this is a copy of multiple links.")
(* ;; "rht 7/1/87: Removed action of changing linkdisplaymode when copying system links.")
(* ;; "rht 1/8/88: Added new condition to disallow links from cards to themselves.")
(DECLARE (GLOBALVARS NC.SystemLinkLabels NC.UnspecifiedLinkLabel))
(LET (Label (Link (NC.FetchLinkFromLinkIcon ImageObject))
SourceCard DestinationCard NewSourceCard NewLabel OldDisplayMode
(Window (AND ToWindowStream (WFROMDS ToWindowStream T)))
InsertPos)
(SETQ Label (fetch (Link Label) of Link))
[SETQ NewSourceCard (COND
((TEXTSTREAMP ToTextStream)
(NC.CoerceToCard ToTextStream))
((WINDOWP Window)
(NC.CoerceToCard Window]
(SETQ SourceCard (fetch (Link SourceCard) of Link))
(SETQ DestinationCard (fetch (Link DestinationCard) of Link))
(SETQ OldDisplayMode (fetch (Link DisplayMode) of Link))
[COND
((AND (NULL NewSourceCard)
(NULL FromTextStream)
(NULL ToTextStream)) (* ;
"We must be moving within a sketch.")
(SETQ NewSourceCard SourceCard))
((TEXTSTREAMP ToTextStream) (* ;
"If it's a text move, then compute position to insert link at.")
(SETQ InsertPos (NC.CharPosFromTextObject (TEXTOBJ ToTextStream]
(COND
((NULL NewSourceCard) (* ;
"Trying to move to a non NoteCard stream")
(NC.PrintMsg Window NIL (CONCAT "Tried to move a NoteCards link icon"
" to a non-NoteCards stream!!." (CHARACTER 13)))
(RETFROM 'TEDIT.MOVE NIL T))
([NULL (NC.LinksSupportedP NewSourceCard '(Local]
(NC.PrintMsg Window NIL (CONCAT "Tried to move a NoteCards link icon"
" to a NoteCard that" " does not support links!!."
(CHARACTER 13)))
(RETFROM 'TEDIT.MOVE NIL T))
((NC.SameCardP NewSourceCard DestinationCard)
(NC.PrintMsg Window NIL (CONCAT
"Sorry, links aren't allowed to point from cards to themselves."
(CHARACTER 13)))
(RETFROM 'TEDIT.MOVE NIL T))
((AND (FMEMB Label '(FiledCard SubBox))
(NEQ (NC.RetrieveType NewSourceCard)
'FileBox)) (* ; "Move from filebox to non-filebox.")
(NC.PrintMsg Window 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))
((AND (NEQ (NC.RetrieveType SourceCard)
'FileBox)
(EQ (NC.RetrieveType NewSourceCard)
'FileBox)) (* ; "Move from non-filebox to filebox.")
(NC.PrintMsg Window NIL (CONCAT "Can't move links from non-filebox to filebox."
(CHARACTER 13)
"Try using PutCardsHere."
(CHARACTER 13)))
(RETFROM 'TEDIT.MOVE NIL T))
([AND (EQ (NC.RetrieveType NewSourceCard)
'FileBox)
(NEQ NewSourceCard SourceCard)
(for Link1 in (NC.FetchToLinks NewSourceCard)
thereis (AND (NC.ChildLinkP Link1)
(EQ DestinationCard (fetch (Link DestinationCard) of Link1]
(* ;
"Move to a filebox already containing this child.")
(NC.PrintMsg Window NIL (CONCAT (NC.RetrieveTitle DestinationCard)
" not moved: already appears as a child of "
(NC.RetrieveTitle NewSourceCard)
(CHARACTER 13)))
(RETFROM 'TEDIT.MOVE NIL T))
([AND (EQ Label 'SubBox)
(NEQ NewSourceCard SourceCard)
(OR (EQ NewSourceCard DestinationCard)
(NOT (NC.NotDaughterP DestinationCard NewSourceCard (FUNCTION NC.ChildLinkP]
(* ; "Move to a filebox causes a cycle.")
(NC.PrintMsg Window NIL (CONCAT "Couldn't move " Link " because of subbox cycle."
(CHARACTER 13)))
(RETFROM 'TEDIT.MOVE NIL T))
((AND (FMEMB Label NC.SystemLinkLabels)
[NOT (FMEMB Label '(FiledCard SubBox]
(NEQ NewSourceCard SourceCard)) (* ;
"Move of system link outside of own card.")
(NC.PrintMsg Window NIL (CONCAT "Tried to copy system link." (CHARACTER 13)
"Link type of copy set to 'Unspecified'."
(CHARACTER 13)))
(SETQ NewLabel NC.UnspecifiedLinkLabel)))
(if (EQ SourceCard NewSourceCard)
then (* ;
"Moving within a card, so just reposition Link in ToLinks list.")
(AND (NC.TEditBasedP SourceCard)
(IMAGEOBJPROP ImageObject 'LinkBeingMovedWithinCard Link))
(NC.SetUserDataProp SourceCard 'LastLinkCopiedOrMoved (NC.AddToLink Link
(NC.LinkAtCharPos
InsertPos
ToTextStream)
T))
else (IMAGEOBJPROP ImageObject 'LinkBeingMoved Link)
(NC.SetUserDataProp NewSourceCard 'LastLinkCopiedOrMoved (NC.FillInLinkIcon
ImageObject
(OR NewLabel Label)
DestinationCard
NewSourceCard
OldDisplayMode
(NC.LinkAtCharPos InsertPos
ToTextStream])
)
(* ;; "Change to NCCARDS")
(DEFINEQ
(NC.EditPropList
[LAMBDA (propList window showOnlyFlg showLinksFlg) (* ; "Edited 10-Feb-88 12:13 by Trigg")
(* ;;; "propList is a list of RECORDS of type PropListItem")
(* ;;; "Edit a property list using the TEDIT menu-based editor. The var window is the window to use. If none supplied, get one from user.")
(* ;; "rht 4/11/86: Now stashes length of propList on WINDOWPROP.")
(* ;; "rht 8/12/86: Moved code to add NC.ClosePropListEditor on CLOSEFN from NC.OpenPropListEditor to here so that it can before TEDIT.DEACTIVATE.WINDOW on the CLOSEFN list.")
(* ;; "rht 1/16/87: Now stashes prop names on windowprop rather than number of props.")
(* ;; "pmi 3/25/87: Added NC.MenuFont to all menus")
(* ;; "rg 11/19/87 menu items put on global vars (for make read-only)")
(* ;;
"rht/rg 11/20/87 Now kills any existing edit process in editW before starting new one.")
(* ;; "rg 11/23/87 added showLinksFlg arg")
(* ;;
"rht 2/10/88: Now passes non-nil LEAVETTY flag as PROP in call to TEDIT in showlinks case.")
(DECLARE (GLOBALVARS NC.MenuFont NC.ShowPropListMenu NC.EditPropListMenu))
(PROG (menuStream textObj editW button editProcess (font (FONTCREATE 'HELVETICA 8))
(CH# 1)
(ENDCH# 1)) (* ;
"Init the editList and the propFnsList")
(* ;
"Create a TEDITMenu that reflects the structure of the proplist")
[SETQ menuStream
(\TEXTMENU.DOC.CREATE
(for X in propList
join (NCONC [LIST (LIST 'MB.BUTTON (MKSTRING (fetch (PropListItem PropertyName)
of X))
(OR (fetch (PropListItem ButtonFn) of X)
(FUNCTION NC.EditPropButtonFN]
(COND
[(NOT (IMAGEOBJP (fetch (PropListItem Value) of X)))
(COND
((fetch (PropListItem AllowEditFlg) of X)
(LIST (LIST 'MB.TEXT (CONCAT (CHARACTER 9)
" ["
(MKSTRING (fetch (PropListItem Value)
of X))
"]"
(CHARACTER 13))
font)))
(T (LIST (LIST 'MB.TEXT (CHARACTER 9)
font)
(LIST 'MB.INSERT (MKSTRING (fetch (PropListItem Value)
of X)))
(LIST 'MB.TEXT (CHARACTER 13)
font]
(T (LIST (LIST 'MB.TEXT (CHARACTER 9)
font)
(LIST 'MB.INSERT)
(LIST 'MB.TEXT (CHARACTER 13)
font]
(SETQ textObj (TEXTOBJ menuStream)) (* ;
"Go back and insert the ImageObjects into their value fields.")
(SETQ CH# 0)
[for prop in propList when (OR (IMAGEOBJP (fetch (PropListItem Value) of prop))
(NULL (fetch (PropListItem AllowEditFlg) of prop)))
do (MBUTTON.FIND.NEXT.FIELD textObj (SETQ CH# (ADD1 CH#)))
(SETQ CH# (fetch CH# of (fetch SCRATCHSEL of textObj)))
(COND
((IMAGEOBJP (CADR prop))
(TEDIT.INSERT.OBJECT (fetch (PropListItem Value) of prop)
menuStream CH#]
(SETQ CH# 0)
(for prop in propList do (SETQ button (MBUTTON.FIND.NEXT.BUTTON textObj (ADD1 CH#)))
(SETQ CH# (CDR button)) (* ;
"If the buttonProtect flag is on, protect the button")
(AND (fetch (PropListItem AllowSelectFlg) of prop)
(IMAGEOBJPROP (CAR button)
'EditPropListNoDelete T)))
(* ; "Set up window and window title")
[SETQ editW (COND
(window window)
(T (CREATEW (GETREGION)
"Edit Property List"]
(* ;; "Point to the proplist being edited so we can update it when this menu is closed. (See NC.CloseEditPropListWindow)")
(WINDOWPROP editW 'PROPERTYLIST.BEING.EDITED propList)
(WINDOWPROP editW 'PROPERTYLIST.PROPNAMES (for Item in propList collect (CAR Item)))
(* ;
"Set the right margin to very-far-away. Prevents stuff from wrapping around")
(TEDIT.PARALOOKS textObj '(RIGHTMARGIN 1000 TABS (50 (80 . LEFT))) 1 (GETFILEINFO
menuStream
'LENGTH))
(* ;
"Set the first tab so the fields will line up correctly")
(* ;
"Set selection to the top -- make it look pretty")
(replace (SELECTION SET) of (fetch (TEXTOBJ SEL) of textObj) with NIL)
(* ;; "Kill any existing tedit process. Notice we have to do WINDOWPROP because calling TEXTSTREAM breaks if window doesn't have one.")
(LET [(OldTextStream (WINDOWPROP editW 'TEXTSTREAM]
(if (TEXTSTREAMP OldTextStream)
then (TEDIT.KILL OldTextStream)))
[SETQ editProcess (TEDIT menuStream editW NIL (if (OR showOnlyFlg showLinksFlg)
then `(MENU ,NC.ShowPropListMenu LEAVETTY
T)
else `(MENU ,NC.EditPropListMenu]
(until (TEDIT-PROCESS-P editProcess) do (BLOCK))
(if showOnlyFlg
then (NC.MakeTEditReadOnly editW))
(WINDOWADDPROP editW 'CLOSEFN (FUNCTION NC.ClosePropListEditor)
T])
)
(PUTPROPS RHTPATCH310 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1503 11247 (NC.LinkIconWhenMovedFn 1513 . 11245)) (11283 18854 (NC.EditPropList 11293
. 18852)))))
STOP