(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED "13-May-88 22:04:49" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH319.;3 11557
changes to%: (VARS RHTPATCH319COMS)
(FNS NC.SetUpGraphEditMenus NC.GetGraphEditMenu NC.ScrollToCH# NC.UpperLeftCH#)
previous date%: "12-May-88 22:53:53" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH319.;1)
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT RHTPATCH319COMS)
(RPAQQ RHTPATCH319COMS ((DECLARE%: DONTCOPY (PROPS (RHTPATCH319 MAKEFILE-ENVIRONMENT)
(RHTPATCH319 FILETYPE)))
[DECLARE%: FIRST (P (NC.LoadFileFromDirectories 'NCBROWSERCARD]
(* ;;
"New functions for NCUTILITIES for doing program controlled scrolling in tedit windows.")
(FNS NC.UpperLeftCH# NC.ScrollToCH#)
(* ;; "New function for NCBROWSERCARD")
(FNS NC.SetUpGraphEditMenus)
(* ;; "Changes to NCBROWSERCARD")
(FNS NC.GetGraphEditMenu)))
(DECLARE%: DONTCOPY
(PUTPROPS RHTPATCH319 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS RHTPATCH319 FILETYPE :TCOMPL)
)
(DECLARE%: FIRST
(NC.LoadFileFromDirectories 'NCBROWSERCARD)
)
(* ;; "New functions for NCUTILITIES for doing program controlled scrolling in tedit windows.")
(DEFINEQ
(NC.UpperLeftCH#
[LAMBDA (TEditWindow) (* ; "Edited 12-May-88 14:37 by Trigg")
(* ;;
"Returns the character number of the first currently displayed character in a tedit window.")
(LET ((TextObj (TEXTOBJ TEditWindow)))
(fetch (SELECTION CH#) of (TEDIT.SELECT 0 (SUB1 (fetch (TEXTOBJ WTOP) of TextObj))
TextObj
(fetch (TEXTOBJ MOUSEREGION) of TextObj)
NIL
'NORMAL TEditWindow])
(NC.ScrollToCH#
[LAMBDA (TEditWindow CH#) (* ; "Edited 12-May-88 22:55 by Trigg")
(* ;; "This code almost totally ripped off from TEDIT.NORMALIZECARET. Only difference is that this scrolls to make CH# be on top line of window even if it would be visible without scrolling.")
(PROG* ((SEL (TEDIT.SETSEL (TEXTSTREAM TEditWindow)
CH# 0 'LEFT))
(TEXTOBJ (TEXTOBJ TEditWindow))
[WINDOW (OR (fetch SELWINDOW of TEXTOBJ)
(CAR (fetch \WINDOW of TEXTOBJ]
(WREG (AND WINDOW (DSPCLIPPINGREGION NIL WINDOW)))
(WHEIGHT (AND WREG (fetch PTOP of WREG)))
(WBOTTOM (AND WREG (fetch BOTTOM of WREG)))
(SELWASON (fetch ONFLG of SEL))
CH# Y LINE)
(OR WINDOW (RETURN))
(OR (fetch SET of SEL)
(RETURN)) (* ;
"If there is no selection set, don't bother.")
(COND
(SELWASON (* ;
"The selection is hilited, so turn it off.")
(\SHOWSEL SEL NIL NIL)))
(for WW inside (fetch \WINDOW of TEXTOBJ) as L1 inside (fetch L1 of SEL) as LN
inside (fetch LN of SEL) when (EQ WW WINDOW)
do
(* ;; "Get to the line info for the SELWINDOW. (failing that, the main/only edit window) Use that info to decide where the caret is.")
(SELECTQ (fetch POINT of SEL)
(LEFT (* ;
"The caret is at the left end of the selection; hunt for the first selected character")
(SETQ CH# (fetch CH# of SEL))
(SETQ Y (OR (AND L1 (fetch YBOT of L1))
(fetch Y0 of SEL))))
(RIGHT (* ;
"The caret is at the right end of the selection; hunt for the last selected character")
(SETQ CH# (SUB1 (fetch CHLIM of SEL)))
(SETQ Y (OR (AND LN (fetch YBOT of LN))
(fetch YLIM of SEL))))
NIL))
(COND
((NOT (fetch TXTNEEDSUPDATE of TEXTOBJ)) (* ;
"The caret is off-screen. Scroll to get it on")
(for LINE inside (fetch L1 of SEL) when LINE do (replace YBOT of LINE
with (SUB1 WBOTTOM)))
(* ;
"Make sure it thinks the old selection is off-screen for now")
(for LINE inside (fetch LN of SEL) when LINE do (replace YBOT of LINE
with (SUB1 WBOTTOM)))
(SETQ LINE (\TEDIT.FIND.FIRST.LINE TEXTOBJ WHEIGHT (IMAX 1
(IMIN CH#
(fetch TEXTLEN
of TEXTOBJ)))
WINDOW)) (* ;
"Find the first line to go in the window")
(replace YBOT of LINE with (IDIFFERENCE WHEIGHT (fetch LHEIGHT of LINE)))
(* ; "Set it up as the top line.")
(replace YBASE of LINE with (IPLUS (fetch YBOT of LINE)
(fetch DESCENT of LINE)))
(\DISPLAYLINE TEXTOBJ LINE WINDOW)
(\FILLWINDOW (fetch YBOT of LINE)
LINE TEXTOBJ NIL WINDOW) (* ;
"And fill out the window from there.")
(\FIXSEL SEL TEXTOBJ)
(\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WINDOW)
(COND
(SELWASON (* ;
"The selection is hilited, so turn it back on.")
(\SHOWSEL SEL NIL T])
)
(* ;; "New function for NCBROWSERCARD")
(DEFINEQ
(NC.SetUpGraphEditMenus
[LAMBDA (Window) (* ; "Edited 13-May-88 21:52 by Trigg")
(* ;; "Create the %"fixed%" and %"unfixed%" menus for browser cards and set them up on the window unless they already exist.")
(DECLARE (GLOBALVARS NC.MenuFont NC.GraphEditMenuItems NC.GraphEditUnfixedMenuItems))
(* ; "Edited 13-May-88 21:48 by Trigg")
(LET [(GraphEditUnfixableMenu (WINDOWPROP Window 'GRAPHEDITUNFIXABLEMENU))
(GraphEditFixableMenu (WINDOWPROP Window 'GRAPHEDITFIXABLEMENU]
[OR GraphEditUnfixableMenu (WINDOWPROP Window 'GRAPHEDITUNFIXABLEMENU
(SETQ GraphEditUnfixableMenu
(create MENU
ITEMS ← NC.GraphEditMenuItems
TITLE ← "Editor Menu"
WHENSELECTEDFN ← (FUNCTION
NC.GraphEditMenuWhenSelectedFn)
CHANGEOFFSETFLG ← T
CENTERFLG ← T
MENUOFFSET ← (CONS -1 0)
MENUFONT ← NC.MenuFont
ITEMHEIGHT ← (IPLUS (FONTPROP NC.MenuFont
'HEIGHT)
1]
(OR GraphEditFixableMenu (WINDOWPROP Window 'GRAPHEDITFIXABLEMENU
(SETQ GraphEditFixableMenu
(create MENU using GraphEditUnfixableMenu ITEMS ←
NC.GraphEditUnfixedMenuItems])
)
(* ;; "Changes to NCBROWSERCARD")
(DEFINEQ
(NC.GetGraphEditMenu
[LAMBDA (Window) (* ; "Edited 13-May-88 21:55 by Trigg")
(* ;; "Create, if necessary, and bring up the graph editor menu.")
(* ;; "pmi 3/25/87: Added NC.MenuFont to all menus")
(* ;;
"rht 1/14/88: Now ensures that both menus are computed rather than just the one needed.")
(* ;; "dwm 1/27/88: Added ReadOnly stuff")
(* ;; "rht 3/3/88: Fixed bug in dwm fix. Card var was unbound.")
(* ;; "rht 5/13/88: Now calls NC.SetUpGraphEditMenus to build menus and stash on window rather than doing it in line.")
(NC.SetUpGraphEditMenus Window)
(LET ((GraphEditUnfixableMenu (WINDOWPROP Window 'GRAPHEDITUNFIXABLEMENU))
(GraphEditFixableMenu (WINDOWPROP Window 'GRAPHEDITFIXABLEMENU))
(Card (NC.CoerceToCard Window))
GraphEditUnfixableMenu GraphEditFixableMenu GraphEditFixedMenuWin)
(* ;; "If menu is already up, then put up a menu without the FIXMENU option, otherwise, allow user to fix menu.")
(if [SETQ GraphEditFixedMenuWin (for Win in (ATTACHEDWINDOWS Window)
thereis (AND (OPENWP Win)
(WINDOWPROP Win 'GRAPHEDITMENUFLG]
then (if (NC.FetchUserDataProp Card 'ReadOnly)
then (REMOVEWINDOW GraphEditFixedMenuWin)
(WINDOWPROP Window 'RIGHTBUTTONFN NIL)
else (PUTMENUPROP GraphEditUnfixableMenu 'MAINWINDOW Window)
(MENU GraphEditUnfixableMenu))
else (if (NC.FetchUserDataProp Card 'ReadOnly)
then (WINDOWPROP Window 'RIGHTBUTTONFN NIL)
else (PUTMENUPROP GraphEditFixableMenu 'MAINWINDOW Window)
(MENU GraphEditFixableMenu])
)
(PUTPROPS RHTPATCH319 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1575 7227 (NC.UpperLeftCH# 1585 . 2256) (NC.ScrollToCH# 2258 . 7225)) (7276 9356 (
NC.SetUpGraphEditMenus 7286 . 9354)) (9399 11474 (NC.GetGraphEditMenu 9409 . 11472)))))
STOP