TEDITWINDOW: Fix offscreen scrolling #669
This commit is contained in:
rmkaplan
parent
ac1fcd2e2e
commit
160cf35f91
@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Jan-2022 23:14:36"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;32 189300
|
||||
(FILECREATED "18-Feb-2022 14:54:02"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;33 187007
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.GETINPUT)
|
||||
:CHANGES-TO (FNS \TEDIT.SCROLLFN)
|
||||
|
||||
:PREVIOUS-DATE " 1-Jan-2022 23:55:46"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;31)
|
||||
:PREVIOUS-DATE "21-Jan-2022 23:14:36"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;32)
|
||||
|
||||
|
||||
(* ; "
|
||||
@ -1969,9 +1969,13 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
])
|
||||
|
||||
(\TEDIT.SCROLLFN
|
||||
[LAMBDA (W DX DY) (* ; "Edited 19-Sep-2021 23:10 by rmk:")
|
||||
(* Handle scrolling of the edit
|
||||
window)
|
||||
[LAMBDA (W DX DY)
|
||||
|
||||
(* ;;
|
||||
"Edited 18-Feb-2022 14:53 by rmk: Repaint after scrolling for windows that are partially off-screen")
|
||||
|
||||
(* ;; "Edited 19-Sep-2021 23:10 by rmk:")
|
||||
(* Handle scrolling of the edit window)
|
||||
(TOTOPW W)
|
||||
(PROG* (WHEIGHT (TEXTOBJ (WINDOWPROP W 'TEXTOBJ))
|
||||
(PRIORCR 0)
|
||||
@ -1985,34 +1989,30 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
((ZEROP (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)))
|
||||
(* Don't scroll a zero-length file)
|
||||
(RETURN))
|
||||
((fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ)
|
||||
(* Don't scroll while something
|
||||
interesting is happening!)
|
||||
((fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ) (* Don't scroll while something
|
||||
interesting is happening!)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress." T)
|
||||
(RETURN))) (* Displaystream for the window)
|
||||
(SETQ WHEIGHT (fetch HEIGHT of WREG)) (* Height of the window)
|
||||
(SETQ LOWESTY WHEIGHT) (* Lowest Y of a line-bottom yet
|
||||
seet)
|
||||
(SETQ WWIDTH (fetch WIDTH of WREG)) (* Width of the window)
|
||||
(SETQ WHEIGHT (fetch HEIGHT of WREG)) (* Height of the window)
|
||||
(SETQ LOWESTY WHEIGHT) (* Lowest Y of a line-bottom yet seet)
|
||||
(SETQ WWIDTH (fetch WIDTH of WREG)) (* Width of the window)
|
||||
(SETQ LINES (WINDOWPROP W 'LINES)) (* List of formatted lines)
|
||||
(AND PRESCROLLFN (DOUSERFNS PRESCROLLFN W)) (* If there's a pre-scroll fn,
|
||||
execute it now.)
|
||||
(AND PRESCROLLFN (DOUSERFNS PRESCROLLFN W)) (* If there's a pre-scroll fn, execute
|
||||
it now.)
|
||||
(COND
|
||||
((fetch (SELECTION SET) of (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)))
|
||||
(* Turn off the selection during the
|
||||
scroll.)
|
||||
scroll.)
|
||||
(SETQ SELWASON (fetch (SELECTION ONFLG) of SEL))
|
||||
(\SHOWSEL SEL NIL NIL)))
|
||||
(SETQ SHIFTEDSELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ SHIFTEDSEL)
|
||||
of TEXTOBJ)))
|
||||
(SETQ SHIFTEDSELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
|
||||
)
|
||||
(\SHOWSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)
|
||||
NIL NIL)
|
||||
(SETQ MOVESELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ MOVESEL)
|
||||
of TEXTOBJ)))
|
||||
(SETQ MOVESELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ MOVESEL) of TEXTOBJ)))
|
||||
(\SHOWSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ)
|
||||
NIL NIL)
|
||||
(SETQ DELETESELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ DELETESEL)
|
||||
of TEXTOBJ)))
|
||||
(SETQ DELETESELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)))
|
||||
(\SHOWSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)
|
||||
NIL NIL)
|
||||
(COND
|
||||
@ -2023,83 +2023,69 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
[(ILESSP 0 DY) (* Scroll text up)
|
||||
(SETQ LINE LINES)
|
||||
(while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
WHEIGHT)) do (SETQ LINE (fetch (LINEDESCRIPTOR
|
||||
NEXTLINE)
|
||||
of LINE)))
|
||||
WHEIGHT)) do (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE)
|
||||
of LINE)))
|
||||
(first [COND
|
||||
((AND LINE (ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
TRUEY)) (* Make sure we scroll up at least
|
||||
one line.)
|
||||
(replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IPLUS (fetch (LINEDESCRIPTOR DESCENT) of
|
||||
LINE)
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE
|
||||
with WHEIGHT)))
|
||||
(SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE]
|
||||
while LINE do (* Find the line whose top is to
|
||||
move to the top of the window)
|
||||
[COND
|
||||
((ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
TRUEY)
|
||||
(RETURN))
|
||||
(T (replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IPLUS (fetch (LINEDESCRIPTOR
|
||||
DESCENT)
|
||||
of LINE)
|
||||
(replace (LINEDESCRIPTOR
|
||||
YBOT) of LINE
|
||||
with WHEIGHT]
|
||||
(SETQ PREVLINE LINE)
|
||||
(SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE)
|
||||
of LINE)))
|
||||
((AND LINE (ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
TRUEY)) (* Make sure we scroll up at least one
|
||||
line.)
|
||||
(replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IPLUS (fetch (LINEDESCRIPTOR DESCENT) of LINE)
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE with WHEIGHT)))
|
||||
(SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE] while LINE
|
||||
do (* Find the line whose top is to move
|
||||
to the top of the window)
|
||||
[COND
|
||||
((ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
TRUEY)
|
||||
(RETURN))
|
||||
(T (replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IPLUS (fetch (LINEDESCRIPTOR DESCENT) of LINE)
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE with WHEIGHT]
|
||||
(SETQ PREVLINE LINE)
|
||||
(SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)))
|
||||
[COND
|
||||
(LINE (* There is a line to go to the top)
|
||||
(SETQ RHEIGHT (IPLUS (fetch (LINEDESCRIPTOR YBASE) of LINE)
|
||||
(fetch (LINEDESCRIPTOR ASCENT) of LINE)))
|
||||
(* Find the Ypos of the top of the
|
||||
line's image)
|
||||
line's image)
|
||||
(BITBLT W 0 0 W 0 (IDIFFERENCE WHEIGHT RHEIGHT)
|
||||
WWIDTH RHEIGHT 'INPUT 'REPLACE)
|
||||
(BITBLT NIL 0 0 W 0 0 WWIDTH (IDIFFERENCE WHEIGHT RHEIGHT)
|
||||
'TEXTURE
|
||||
'REPLACE WHITESHADE)
|
||||
[bind NL (PL _ PREVLINE) for I from 1 to 50 while
|
||||
PL
|
||||
do (* Let him keep 50 lines above what
|
||||
he can see on the screen)
|
||||
(SETQ PL (fetch (LINEDESCRIPTOR PREVLINE) of PL))
|
||||
[bind NL (PL _ PREVLINE) for I from 1 to 50 while PL
|
||||
do (* Let him keep 50 lines above what he
|
||||
can see on the screen)
|
||||
(SETQ PL (fetch (LINEDESCRIPTOR PREVLINE) of PL))
|
||||
finally (COND
|
||||
((AND PL (NEQ PL LINES))
|
||||
((AND PL (NEQ PL LINES))
|
||||
(* There were more than 50 lines
|
||||
(and we aren't pointing at the root)
|
||||
%, so lop the spare ones off.)
|
||||
(SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE)
|
||||
of LINES))
|
||||
(UNINTERRUPTABLY
|
||||
(replace (LINEDESCRIPTOR NEXTLINE)
|
||||
of LINES with PL)
|
||||
(replace (LINEDESCRIPTOR PREVLINE)
|
||||
of PL with LINES))
|
||||
(bind NNL while (AND NL (NEQ NL PL))
|
||||
do (SETQ NNL NL)
|
||||
(SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE)
|
||||
of NL))
|
||||
(replace (LINEDESCRIPTOR NEXTLINE)
|
||||
of NNL with NIL]
|
||||
(and we aren't pointing at the root)%,
|
||||
so lop the spare ones off.)
|
||||
(SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE) of LINES))
|
||||
(UNINTERRUPTABLY
|
||||
(replace (LINEDESCRIPTOR NEXTLINE) of LINES
|
||||
with PL)
|
||||
(replace (LINEDESCRIPTOR PREVLINE) of PL with LINES))
|
||||
(bind NNL while (AND NL (NEQ NL PL))
|
||||
do (SETQ NNL NL)
|
||||
(SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE)
|
||||
of NL))
|
||||
(replace (LINEDESCRIPTOR NEXTLINE) of NNL
|
||||
with NIL]
|
||||
(while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
(fetch BOTTOM of WREG)))
|
||||
do (* Update the bottom and baseline)
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE
|
||||
with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of
|
||||
LINE)
|
||||
(IDIFFERENCE WHEIGHT RHEIGHT)))
|
||||
(replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of
|
||||
LINE)
|
||||
(fetch (LINEDESCRIPTOR DESCENT)
|
||||
of LINE)))
|
||||
(SETQ PREVLINE LINE)
|
||||
(SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE]
|
||||
(fetch BOTTOM of WREG)))
|
||||
do (* Update the bottom and baseline)
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE
|
||||
with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
(IDIFFERENCE WHEIGHT RHEIGHT)))
|
||||
(replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
(fetch (LINEDESCRIPTOR DESCENT) of LINE)))
|
||||
(SETQ PREVLINE LINE)
|
||||
(SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE]
|
||||
(COND
|
||||
((AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
(fetch BOTTOM of WREG)))
|
||||
@ -2108,72 +2094,67 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
LINE TEXTOBJ NIL W))
|
||||
(PREVLINE (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of PREVLINE)
|
||||
PREVLINE TEXTOBJ NIL W]
|
||||
(T (* Scroll text down in window,
|
||||
adding lines at top to fill.)
|
||||
(T (* Scroll text down in window, adding
|
||||
lines at top to fill.)
|
||||
(SETQ PREVLINE (SETQ TOPLINE LINES)) (* Find the top line on the screen%:)
|
||||
[while TOPLINE do
|
||||
|
||||
(* Run thru the lines, until we hit the first one that is below the top of the
|
||||
edit window)
|
||||
edit window)
|
||||
|
||||
(COND
|
||||
((ILESSP (fetch (LINEDESCRIPTOR YBOT)
|
||||
of TOPLINE)
|
||||
WHEIGHT)
|
||||
(RETURN))
|
||||
(T (SETQ PREVLINE TOPLINE)
|
||||
(SETQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE
|
||||
) of TOPLINE]
|
||||
(COND
|
||||
((ILESSP (fetch (LINEDESCRIPTOR YBOT) of TOPLINE)
|
||||
WHEIGHT)
|
||||
(RETURN))
|
||||
(T (SETQ PREVLINE TOPLINE)
|
||||
(SETQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE)
|
||||
of TOPLINE]
|
||||
[COND
|
||||
((AND (EQ PREVLINE LINES)
|
||||
(OR (NOT (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE))
|
||||
(IGREATERP (fetch (LINEDESCRIPTOR CHAR1)
|
||||
of (fetch (LINEDESCRIPTOR NEXTLINE)
|
||||
of PREVLINE))
|
||||
(IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of (fetch (LINEDESCRIPTOR
|
||||
NEXTLINE)
|
||||
of PREVLINE))
|
||||
1))) (* There's nothing between us and
|
||||
start of file that's formatted;
|
||||
start by making some.)
|
||||
start of file that's formatted;
|
||||
start by making some.)
|
||||
(SETQ PREVLINE (\BACKFORMAT LINES TEXTOBJ WHEIGHT]
|
||||
(SETQ THEIGHT 0)
|
||||
|
||||
(* Accumulates the heights of the lines we've backed over.
|
||||
When this exceeds the scrolling distance, we've found the line.)
|
||||
When this exceeds the scrolling distance, we've found the line.)
|
||||
|
||||
(bind (FIRSTTIME _ T) while (OR FIRSTTIME
|
||||
(AND (ILESSP THEIGHT (IABS DY))
|
||||
(IGEQ (fetch (LINEDESCRIPTOR
|
||||
CHAR1)
|
||||
of PREVLINE)
|
||||
1)))
|
||||
(bind (FIRSTTIME _ T) while (OR FIRSTTIME (AND (ILESSP THEIGHT (IABS DY))
|
||||
(IGEQ (fetch (LINEDESCRIPTOR
|
||||
CHAR1) of PREVLINE)
|
||||
1)))
|
||||
do
|
||||
|
||||
(* Starting with PREVLINE, accumulate LHEIGHTs until we hit top of text or have
|
||||
accumulated enough lines to fill the screen)
|
||||
accumulated enough lines to fill the screen)
|
||||
|
||||
(add THEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of PREVLINE))
|
||||
(SETQ PREVLINE (fetch (LINEDESCRIPTOR PREVLINE) of PREVLINE))
|
||||
[COND
|
||||
((OR (NOT PREVLINE)
|
||||
(ILESSP (fetch (LINEDESCRIPTOR CHAR1) of PREVLINE)
|
||||
1)) (* We need to format some lines
|
||||
above where we are --
|
||||
go do it.)
|
||||
(SETQ PREVLINE (\BACKFORMAT LINES TEXTOBJ WHEIGHT]
|
||||
(SETQ FIRSTTIME NIL))
|
||||
(add THEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of PREVLINE))
|
||||
(SETQ PREVLINE (fetch (LINEDESCRIPTOR PREVLINE) of PREVLINE))
|
||||
[COND
|
||||
((OR (NOT PREVLINE)
|
||||
(ILESSP (fetch (LINEDESCRIPTOR CHAR1) of PREVLINE)
|
||||
1)) (* We need to format some lines above
|
||||
where we are -- go do it.)
|
||||
(SETQ PREVLINE (\BACKFORMAT LINES TEXTOBJ WHEIGHT]
|
||||
(SETQ FIRSTTIME NIL))
|
||||
[COND
|
||||
([OR (EQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE))
|
||||
(EQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE)
|
||||
of (fetch (LINEDESCRIPTOR NEXTLINE) of
|
||||
PREVLINE
|
||||
]
|
||||
(EQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE) of (fetch (LINEDESCRIPTOR
|
||||
NEXTLINE)
|
||||
of PREVLINE]
|
||||
|
||||
(* Always move at least one line backward.
|
||||
So if we're about to move no lines, force a single line.)
|
||||
So if we're about to move no lines, force a single line.)
|
||||
|
||||
)
|
||||
((ILESSP (IABS DY)
|
||||
THEIGHT) (* BACK UP ONE LINE TO GET TO THE
|
||||
ONE WHICH PUSHED US OVER TOP)
|
||||
THEIGHT) (* BACK UP ONE LINE TO GET TO THE ONE
|
||||
WHICH PUSHED US OVER TOP)
|
||||
(SETQ PREVLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE))
|
||||
(SETQ THEIGHT (IDIFFERENCE THEIGHT (fetch (LINEDESCRIPTOR LHEIGHT)
|
||||
of PREVLINE]
|
||||
@ -2181,7 +2162,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
((NEQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE))
|
||||
(SETQ PREVLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE]
|
||||
(* Move to the first line to be
|
||||
formatted.-)
|
||||
formatted.-)
|
||||
(BITBLT W 0 THEIGHT W 0 0 WWIDTH (IDIFFERENCE WHEIGHT THEIGHT)
|
||||
'INPUT
|
||||
'REPLACE)
|
||||
@ -2189,27 +2170,25 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
WWIDTH THEIGHT 'TEXTURE 'REPLACE WHITESHADE)
|
||||
(bind (LINE _ TOPLINE) while LINE
|
||||
do (COND
|
||||
((IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
(IPLUS (fetch BOTTOM of WREG)
|
||||
THEIGHT)) (* This line will be on screen.
|
||||
Adjust its YBOT/YBASE)
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE
|
||||
with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT)
|
||||
of LINE)
|
||||
THEIGHT))
|
||||
(replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBASE)
|
||||
of LINE)
|
||||
THEIGHT))
|
||||
(SETQ LOWESTY (fetch (LINEDESCRIPTOR YBOT) of LINE)))
|
||||
(T (replace (LINEDESCRIPTOR YBOT) of LINE
|
||||
with (SUB1 (fetch BOTTOM of WREG)))
|
||||
(replace (LINEDESCRIPTOR NEXTLINE)
|
||||
of (fetch (LINEDESCRIPTOR PREVLINE) of LINE)
|
||||
with NIL)
|
||||
(SETQ LINE (fetch (LINEDESCRIPTOR PREVLINE) of LINE))
|
||||
(RETURN)))
|
||||
(SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))
|
||||
((IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
(IPLUS (fetch BOTTOM of WREG)
|
||||
THEIGHT)) (* This line will be on screen.
|
||||
Adjust its YBOT/YBASE)
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE
|
||||
with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
THEIGHT))
|
||||
(replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBASE) of LINE)
|
||||
THEIGHT))
|
||||
(SETQ LOWESTY (fetch (LINEDESCRIPTOR YBOT) of LINE)))
|
||||
(T (replace (LINEDESCRIPTOR YBOT) of LINE
|
||||
with (SUB1 (fetch BOTTOM of WREG)))
|
||||
(replace (LINEDESCRIPTOR NEXTLINE) of (fetch (LINEDESCRIPTOR
|
||||
PREVLINE)
|
||||
of LINE) with NIL)
|
||||
(SETQ LINE (fetch (LINEDESCRIPTOR PREVLINE) of LINE))
|
||||
(RETURN)))
|
||||
(SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))
|
||||
(* Clear anything below us))
|
||||
(BITBLT NIL 0 0 W 0 (fetch BOTTOM of WREG)
|
||||
WWIDTH
|
||||
@ -2221,104 +2200,89 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
do
|
||||
|
||||
(* Move down lines to be added, adjusting YBOT/YBASE and DISPALYLINE-ing them,
|
||||
until the next line to do EQ TOPLINE)
|
||||
until the next line to do EQ TOPLINE)
|
||||
|
||||
[replace (LINEDESCRIPTOR YBOT) of PREVLINE
|
||||
with (COND
|
||||
[(AND (fetch (LINEDESCRIPTOR PREVLINE) of
|
||||
PREVLINE
|
||||
)
|
||||
(IGREATERP (fetch (LINEDESCRIPTOR CHAR1)
|
||||
of PREVLINE)
|
||||
0)
|
||||
(fetch (FMTSPEC FMTBASETOBASE)
|
||||
of (fetch (LINEDESCRIPTOR LFMTSPEC)
|
||||
of PREVLINE)))
|
||||
(SETQ YBOT (IDIFFERENCE
|
||||
(IPLUS YBOT (fetch (LINEDESCRIPTOR
|
||||
DESCENT)
|
||||
of (fetch
|
||||
(LINEDESCRIPTOR
|
||||
PREVLINE)
|
||||
of PREVLINE)))
|
||||
(IPLUS (fetch (FMTSPEC FMTBASETOBASE)
|
||||
of (fetch (LINEDESCRIPTOR
|
||||
LFMTSPEC)
|
||||
of PREVLINE))
|
||||
(fetch (LINEDESCRIPTOR DESCENT)
|
||||
of PREVLINE]
|
||||
(T (SETQ YBOT (IDIFFERENCE YBOT (fetch (
|
||||
[replace (LINEDESCRIPTOR YBOT) of PREVLINE
|
||||
with (COND
|
||||
[(AND (fetch (LINEDESCRIPTOR PREVLINE) of PREVLINE)
|
||||
(IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of PREVLINE)
|
||||
0)
|
||||
(fetch (FMTSPEC FMTBASETOBASE) of (fetch (LINEDESCRIPTOR
|
||||
LFMTSPEC)
|
||||
of PREVLINE)))
|
||||
(SETQ YBOT (IDIFFERENCE (IPLUS YBOT (fetch (LINEDESCRIPTOR
|
||||
DESCENT)
|
||||
of (fetch (
|
||||
LINEDESCRIPTOR
|
||||
LHEIGHT)
|
||||
of PREVLINE]
|
||||
(replace (LINEDESCRIPTOR YBASE) of PREVLINE
|
||||
with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of PREVLINE)
|
||||
(fetch (LINEDESCRIPTOR DESCENT) of PREVLINE)
|
||||
))
|
||||
(\DISPLAYLINE TEXTOBJ PREVLINE W)
|
||||
(SETQ PREVLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE]
|
||||
PREVLINE)
|
||||
of PREVLINE)))
|
||||
(IPLUS (fetch (FMTSPEC FMTBASETOBASE)
|
||||
of (fetch (LINEDESCRIPTOR LFMTSPEC
|
||||
) of PREVLINE))
|
||||
(fetch (LINEDESCRIPTOR DESCENT)
|
||||
of PREVLINE]
|
||||
(T (SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR LHEIGHT)
|
||||
of PREVLINE]
|
||||
(replace (LINEDESCRIPTOR YBASE) of PREVLINE
|
||||
with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of PREVLINE)
|
||||
(fetch (LINEDESCRIPTOR DESCENT) of PREVLINE)))
|
||||
(\DISPLAYLINE TEXTOBJ PREVLINE W)
|
||||
(SETQ PREVLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE]
|
||||
((FLOATP DY) (* Do a thumbing-type scroll)
|
||||
(SETQ CH# (IMAX (IMIN (SUB1 TEXTLEN)
|
||||
(FIXR (FTIMES TEXTLEN DY)))
|
||||
1))
|
||||
(SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINES))
|
||||
[while (AND LINE (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) of LINE)
|
||||
CH#)) do (SETQ LINE (fetch (LINEDESCRIPTOR
|
||||
NEXTLINE)
|
||||
of LINE))
|
||||
CH#)) do (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE)
|
||||
of LINE))
|
||||
finally (COND
|
||||
((AND LINE (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of
|
||||
LINE)
|
||||
CH#))
|
||||
(SETQ LINE NIL] (* find out if any line currently
|
||||
formatted includes the target char)
|
||||
((AND LINE (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of LINE)
|
||||
CH#))
|
||||
(SETQ LINE NIL] (* find out if any line currently
|
||||
formatted includes the target char)
|
||||
(COND
|
||||
((AND LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)
|
||||
(IGEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE)
|
||||
1))
|
||||
|
||||
(* If so, let's do this as a fast scroll, rather than a complete repaint of the
|
||||
screen)
|
||||
screen)
|
||||
|
||||
[SETQ DY (COND
|
||||
[(ILEQ WHEIGHT (fetch (LINEDESCRIPTOR YBOT) of LINE))
|
||||
(* this line is off the top of the
|
||||
window)
|
||||
window)
|
||||
(IMINUS (for (DESCENDLINE _ (fetch (LINEDESCRIPTOR NEXTLINE)
|
||||
of LINE))
|
||||
by (fetch (LINEDESCRIPTOR NEXTLINE) of
|
||||
DESCENDLINE
|
||||
)
|
||||
while (AND DESCENDLINE (ILEQ WHEIGHT
|
||||
(fetch (
|
||||
of LINE))
|
||||
by (fetch (LINEDESCRIPTOR NEXTLINE) of DESCENDLINE)
|
||||
while (AND DESCENDLINE (ILEQ WHEIGHT (fetch (
|
||||
LINEDESCRIPTOR
|
||||
YBOT)
|
||||
of DESCENDLINE)))
|
||||
of DESCENDLINE)))
|
||||
sum
|
||||
|
||||
(* sum the heights of all the lines in between the new top line and the present
|
||||
top line)
|
||||
top line)
|
||||
|
||||
(fetch (LINEDESCRIPTOR LHEIGHT) of
|
||||
DESCENDLINE
|
||||
]
|
||||
(fetch (LINEDESCRIPTOR LHEIGHT) of DESCENDLINE]
|
||||
(T (IDIFFERENCE (IDIFFERENCE WHEIGHT (fetch (LINEDESCRIPTOR YBOT)
|
||||
of LINE))
|
||||
(fetch (LINEDESCRIPTOR LHEIGHT) of LINE]
|
||||
(\TEDIT.SCROLLFN W 0 DY)
|
||||
|
||||
(* recurse telling to normally scroll instead of thumb scroll so that the
|
||||
screen is not blanked and reformatted unnecessarily)
|
||||
(* recurse telling to normally scroll instead of thumb scroll so that the screen
|
||||
is not blanked and reformatted unnecessarily)
|
||||
|
||||
)
|
||||
(T [for LINE inside (fetch (SELECTION L1) of SEL) when LINE
|
||||
do (replace (LINEDESCRIPTOR YBOT) of LINE
|
||||
with (SUB1 (fetch BOTTOM of WREG]
|
||||
do (replace (LINEDESCRIPTOR YBOT) of LINE with (SUB1 (fetch BOTTOM
|
||||
of WREG]
|
||||
(* Make sure it thinks the old
|
||||
selection is off-screen for now)
|
||||
selection is off-screen for now)
|
||||
[for LINE inside (fetch (SELECTION LN) of SEL) when LINE
|
||||
do (replace (LINEDESCRIPTOR YBOT) of LINE
|
||||
with (SUB1 (fetch BOTTOM of WREG]
|
||||
do (replace (LINEDESCRIPTOR YBOT) of LINE with (SUB1 (fetch BOTTOM
|
||||
of WREG]
|
||||
(BITBLT NIL 0 0 W 0 (fetch BOTTOM of WREG)
|
||||
WWIDTH
|
||||
(IDIFFERENCE WHEIGHT (fetch BOTTOM of WREG))
|
||||
@ -2326,20 +2290,20 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
'REPLACE WHITESHADE)
|
||||
(SETQ LINE (\TEDIT.FIND.FIRST.LINE TEXTOBJ WHEIGHT CH# W))
|
||||
(* Find the first line to go in the
|
||||
window)
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE with
|
||||
(IDIFFERENCE WHEIGHT
|
||||
(fetch (LINEDESCRIPTOR
|
||||
LHEIGHT)
|
||||
of LINE)))
|
||||
window)
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE with (IDIFFERENCE WHEIGHT
|
||||
(fetch (LINEDESCRIPTOR
|
||||
LHEIGHT)
|
||||
of LINE)))
|
||||
(* Set it up as the top line.)
|
||||
(replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
(fetch (LINEDESCRIPTOR DESCENT) of LINE)))
|
||||
(replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS (fetch (LINEDESCRIPTOR
|
||||
YBOT) of LINE)
|
||||
(fetch (LINEDESCRIPTOR
|
||||
DESCENT)
|
||||
of LINE)))
|
||||
(\DISPLAYLINE TEXTOBJ LINE W)
|
||||
(\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of LINE)
|
||||
LINE TEXTOBJ NIL W))) (* And fill out the window from
|
||||
there.)
|
||||
LINE TEXTOBJ NIL W))) (* And fill out the window from there.)
|
||||
))
|
||||
(AND POSTSCROLLFN (DOUSERFNS POSTSCROLLFN W)) (* For user subsystem cleanup)
|
||||
[COND
|
||||
@ -2364,7 +2328,21 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
TEXTOBJ)
|
||||
(AND DELETESELWASON (\SHOWSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)
|
||||
NIL T]
|
||||
(\TEDIT.SET.WINDOW.EXTENT TEXTOBJ W])
|
||||
(\TEDIT.SET.WINDOW.EXTENT TEXTOBJ W))
|
||||
|
||||
(* ;; "rmk: This makes scrolling for partially off-screen window work properly.")
|
||||
|
||||
(CL:UNLESS (LET [(WREG (WINDOWPROP W 'REGION]
|
||||
(AND (IGEQ (FETCH (REGION BOTTOM) OF WREG)
|
||||
0)
|
||||
(IGEQ (FETCH (REGION LEFT) OF WREG)
|
||||
0)
|
||||
(ILEQ (FETCH (REGION PTOP) OF WREG)
|
||||
SCREENHEIGHT)
|
||||
(ILEQ (FETCH (REGION PRIGHT) OF WREG)
|
||||
SCREENWIDTH)))
|
||||
(\TEDIT.REPAINTFN W))
|
||||
NIL])
|
||||
)
|
||||
|
||||
|
||||
@ -2874,25 +2852,25 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
(PUTPROPS TEDITWINDOW COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988
|
||||
1989 1990 1991 1993 1994 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (7221 95655 (TEDIT.CREATEW 7231 . 9985) (\TEDIT.CREATEW.FROM.REGION 9987 . 10971) (
|
||||
TEDIT.CURSORMOVEDFN 10973 . 22359) (TEDIT.CURSOROUTFN 22361 . 22896) (TEDIT.WINDOW.SETUP 22898 . 24707
|
||||
) (TEDIT.MINIMAL.WINDOW.SETUP 24709 . 32498) (\TEDIT.ACTIVE.WINDOWP 32500 . 33481) (
|
||||
\TEDIT.BUTTONEVENTFN 33483 . 58473) (\TEDIT.WINDOW.OPS 58475 . 62436) (\TEDIT.EXPANDFN 62438 . 62841)
|
||||
(\TEDIT.MAINW 62843 . 64132) (\TEDIT.PRIMARYW 64134 . 65346) (\TEDIT.COPYINSERTFN 65348 . 66319) (
|
||||
\TEDIT.NEWREGIONFN 66321 . 68788) (\TEDIT.SET.WINDOW.EXTENT 68790 . 74892) (\TEDIT.SHRINK.ICONCREATE
|
||||
74894 . 77166) (\TEDIT.SHRINKFN 77168 . 77743) (\TEDIT.SPLITW 77745 . 83846) (\TEDIT.UNSPLITW 83848 .
|
||||
89542) (\TEDIT.WINDOW.SETUP 89544 . 95264) (\SAFE.FIRST 95266 . 95653)) (96985 97892 (TEDITWINDOWP
|
||||
96995 . 97890)) (97929 100502 (TEDIT.GETINPUT 97939 . 99999) (\TEDIT.MAKEFILENAME 100001 . 100500)) (
|
||||
100551 107002 (TEDIT.PROMPTPRINT 100561 . 103465) (TEDIT.PROMPTFLASH 103467 . 105422) (
|
||||
\TEDIT.PROMPT.PAGEFULLFN 105424 . 107000)) (107237 111230 (TEXTSTREAM.TITLE 107247 . 107868) (
|
||||
\TEDIT.ORIGINAL.WINDOW.TITLE 107870 . 109846) (\TEDIT.WINDOW.TITLE 109848 . 110518) (
|
||||
\TEXTSTREAM.FILENAME 110520 . 111228)) (111273 156172 (TEDIT.DEACTIVATE.WINDOW 111283 . 118590) (
|
||||
\TEDIT.REPAINTFN 118592 . 121449) (\TEDIT.RESHAPEFN 121451 . 127071) (\TEDIT.SCROLLFN 127073 . 156170)
|
||||
) (156214 158263 (\TEDIT.PROCIDLEFN 156224 . 157573) (\TEDIT.PROCENTRYFN 157575 . 157868) (
|
||||
\TEDIT.PROCEXITFN 157870 . 158261)) (158342 169342 (\EDIT.DOWNCARET 158352 . 159033) (\EDIT.FLIPCARET
|
||||
159035 . 160570) (TEDIT.FLASHCARET 160572 . 161686) (\EDIT.UPCARET 161688 . 162141) (
|
||||
TEDIT.NORMALIZECARET 162143 . 168094) (\SETCARET 168096 . 169016) (\TEDIT.CARET 169018 . 169340)) (
|
||||
169376 183131 (TEDIT.ADD.MENUITEM 169386 . 171301) (TEDIT.DEFAULT.MENUFN 171303 . 180570) (
|
||||
TEDIT.REMOVE.MENUITEM 180572 . 181573) (\TEDIT.CREATEMENU 181575 . 182028) (\TEDIT.MENU.WHENHELDFN
|
||||
182030 . 182800) (\TEDIT.MENU.WHENSELECTEDFN 182802 . 183129)))))
|
||||
(FILEMAP (NIL (7222 95656 (TEDIT.CREATEW 7232 . 9986) (\TEDIT.CREATEW.FROM.REGION 9988 . 10972) (
|
||||
TEDIT.CURSORMOVEDFN 10974 . 22360) (TEDIT.CURSOROUTFN 22362 . 22897) (TEDIT.WINDOW.SETUP 22899 . 24708
|
||||
) (TEDIT.MINIMAL.WINDOW.SETUP 24710 . 32499) (\TEDIT.ACTIVE.WINDOWP 32501 . 33482) (
|
||||
\TEDIT.BUTTONEVENTFN 33484 . 58474) (\TEDIT.WINDOW.OPS 58476 . 62437) (\TEDIT.EXPANDFN 62439 . 62842)
|
||||
(\TEDIT.MAINW 62844 . 64133) (\TEDIT.PRIMARYW 64135 . 65347) (\TEDIT.COPYINSERTFN 65349 . 66320) (
|
||||
\TEDIT.NEWREGIONFN 66322 . 68789) (\TEDIT.SET.WINDOW.EXTENT 68791 . 74893) (\TEDIT.SHRINK.ICONCREATE
|
||||
74895 . 77167) (\TEDIT.SHRINKFN 77169 . 77744) (\TEDIT.SPLITW 77746 . 83847) (\TEDIT.UNSPLITW 83849 .
|
||||
89543) (\TEDIT.WINDOW.SETUP 89545 . 95265) (\SAFE.FIRST 95267 . 95654)) (96986 97893 (TEDITWINDOWP
|
||||
96996 . 97891)) (97930 100503 (TEDIT.GETINPUT 97940 . 100000) (\TEDIT.MAKEFILENAME 100002 . 100501)) (
|
||||
100552 107003 (TEDIT.PROMPTPRINT 100562 . 103466) (TEDIT.PROMPTFLASH 103468 . 105423) (
|
||||
\TEDIT.PROMPT.PAGEFULLFN 105425 . 107001)) (107238 111231 (TEXTSTREAM.TITLE 107248 . 107869) (
|
||||
\TEDIT.ORIGINAL.WINDOW.TITLE 107871 . 109847) (\TEDIT.WINDOW.TITLE 109849 . 110519) (
|
||||
\TEXTSTREAM.FILENAME 110521 . 111229)) (111274 153879 (TEDIT.DEACTIVATE.WINDOW 111284 . 118591) (
|
||||
\TEDIT.REPAINTFN 118593 . 121450) (\TEDIT.RESHAPEFN 121452 . 127072) (\TEDIT.SCROLLFN 127074 . 153877)
|
||||
) (153921 155970 (\TEDIT.PROCIDLEFN 153931 . 155280) (\TEDIT.PROCENTRYFN 155282 . 155575) (
|
||||
\TEDIT.PROCEXITFN 155577 . 155968)) (156049 167049 (\EDIT.DOWNCARET 156059 . 156740) (\EDIT.FLIPCARET
|
||||
156742 . 158277) (TEDIT.FLASHCARET 158279 . 159393) (\EDIT.UPCARET 159395 . 159848) (
|
||||
TEDIT.NORMALIZECARET 159850 . 165801) (\SETCARET 165803 . 166723) (\TEDIT.CARET 166725 . 167047)) (
|
||||
167083 180838 (TEDIT.ADD.MENUITEM 167093 . 169008) (TEDIT.DEFAULT.MENUFN 169010 . 178277) (
|
||||
TEDIT.REMOVE.MENUITEM 178279 . 179280) (\TEDIT.CREATEMENU 179282 . 179735) (\TEDIT.MENU.WHENHELDFN
|
||||
179737 . 180507) (\TEDIT.MENU.WHENSELECTEDFN 180509 . 180836)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user