(FILECREATED "16-Oct-85 19:29:06" {ERIS}<TEDIT>TEDITSELECTION.;13 98109
changes to: (FNS \SHOWSEL \SHOWSEL.HILIGHT)
previous date: "30-Sep-85 16:43:10" {ERIS}<TEDIT>TEDITSELECTION.;12)
(* Copyright (c) 1983, 1984, 1985 by John Sybalsky & Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEDITSELECTIONCOMS)
(RPAQQ TEDITSELECTIONCOMS ((RECORDS SELECTION)
(FNS TEDIT.SEL.AS.STRING TEDIT.SELECTED.PIECES \TEDIT.FIND.FIRST.LINE
\TEDIT.FIND.LAST.LINE \TEDIT.FIND.OVERLAPPING.LINE
\TEDIT.FIND.PROTECTED.END \TEDIT.FIND.PROTECTED.START
\TEDIT.WORD.BOUND)
(FILES TEXTOFD)
(CONSTANTS (COPYSELSHADE 30583)
(COPYLOOKSSELSHADE 30583)
(EDITMOVESHADE -1)
(EDITGRAY 32800))
(INITVARS (TEDIT.EXTEND.PENDING.DELETE T))
(VARS (TEDIT.SELECTION (create SELECTION))
(TEDIT.SCRATCHSELECTION (create SELECTION))
(TEDIT.SHIFTEDSELECTION (create SELECTION HOW←COPYSELSHADE
HASCARET←NIL))
(TEDIT.COPYLOOKSSELECTION (create SELECTION HOW←COPYLOOKSSELSHADE
HASCARET←NIL))
(TEDIT.MOVESELECTION (CREATE SELECTION HOW←EDITMOVESHADE
HASCARET←NIL HOWHEIGHT←32767))
(TEDIT.DELETESELECTION (CREATE SELECTION HOW←BLACKSHADE
HASCARET←NIL HOWHEIGHT←32767))
SELECTION SELECTION (TEDIT.SELPENDING NIL))
(GLOBALVARS TEDIT.SELECTION TEDIT.SCRATCHSELECTION TEDIT.MOVESELECTION
TEDIT.SHIFTEDSELECTION TEDIT.COPYLOOKSSELECTION
TEDIT.DELETESELECTION TEDIT.SELPENDING
TEDIT.EXTEND.PENDING.DELETE)
(COMS (* Selection manipulating code)
(FNS TEDIT.EXTEND.SEL TEDIT.SELECT TEDIT.SCAN.LINE
TEDIT.SELECT.LINE.SCANNER \TEDIT.SELECT.CHARACTER)
(FNS \FIXSEL \TEDIT.FIXDELSEL \TEDIT.FIXINSSEL \TEDIT.FIXSELS)
(FNS TEDIT.RESET.EXTEND.PENDING.DELETE \TEDIT.SET.SEL.LOOKS)
(FNS \SHOWSEL \SHOWSEL.HILIGHT \TEDIT.UPDATE.SHOWSEL
\TEDIT.SHOWSELS \TEDIT.REFRESH.SHOWSEL)
(FNS \COPYSEL \TEDIT.SEL.CHANGED?))
(COMS (* * User entries to the selection code)
(FNS TEDIT.GETPOINT TEDIT.GETSEL TEDIT.MAKESEL TEDIT.SCANSEL
TEDIT.SET.SEL.LOOKS TEDIT.SETSEL TEDIT.SHOWSEL))))
[DECLARE: EVAL@COMPILE
(DATATYPE SELECTION (Y0 (* Y value of topmost line of selection)
X0 (* X value of left edge of selection)
DX (* Width of the selection, if it's on one line.)
CH# (* CH# of the first selected character)
XLIM (* X value of right edge of last selected character)
CHLIM (* CH# of the last character in the selection)
DCH (* # of characters selected
(can be zero, for point selection.))
L1 (* -> line descriptor for the line where the first
selected character is)
LN (* -> line descriptor for the line which contains the
end of the selection)
YLIM (* Y value of the bottom of the line that ends the
selection)
POINT (* Which end should the caret appear at?
(LEFT or RIGHT))
(SET FLAG) (* T if this selection is real;
NIL if not)
(\TEXTOBJ FULLXPOINTER) (* TEXTOBJ that describes the selected text)
SELKIND (* What kind of selection? CHAR or WORD or LINE or
PARA)
HOW (* SHADE used to highlight this selection)
HOWHEIGHT (* Height of the highlight
(1 usually, full line for delete selection...))
(HASCARET FLAG) (* T if there should be a caret for this selection)
SELOBJ (* If this selection is inside an object, which
object?)
(ONFLG FLAG) (* T if the selection is highlighted on the screen,
else NIL)
SELOBJINFO (* A Place for the selected object to put info about
selection inside itself.)
)
SET ← NIL HOW ← BLACKSHADE HOWHEIGHT ← 1 HASCARET ← T Y0 ← 0 X0 ← 0 POINT ←(QUOTE LEFT)
L1 ←(LIST NIL)
LN ←(LIST NIL))
]
(/DECLAREDATATYPE (QUOTE SELECTION)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER FLAG FULLXPOINTER POINTER POINTER POINTER FLAG
POINTER FLAG POINTER))
(QUOTE ((SELECTION 0 POINTER)
(SELECTION 2 POINTER)
(SELECTION 4 POINTER)
(SELECTION 6 POINTER)
(SELECTION 8 POINTER)
(SELECTION 10 POINTER)
(SELECTION 12 POINTER)
(SELECTION 14 POINTER)
(SELECTION 16 POINTER)
(SELECTION 18 POINTER)
(SELECTION 20 POINTER)
(SELECTION 20 (FLAGBITS . 0))
(SELECTION 22 FULLXPOINTER)
(SELECTION 24 POINTER)
(SELECTION 26 POINTER)
(SELECTION 28 POINTER)
(SELECTION 28 (FLAGBITS . 0))
(SELECTION 30 POINTER)
(SELECTION 30 (FLAGBITS . 0))
(SELECTION 32 POINTER)))
(QUOTE 34))
(DEFINEQ
(TEDIT.SEL.AS.STRING
[LAMBDA (STREAM SEL) (* jds "29-Jul-85 14:00")
(* Given a text stream, go to the TEXTOBJ, get the
current selection, and return it as a string.)
(SETQ STREAM (TEXTSTREAM STREAM))
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
LEN TSEL RESULT OFFST BASE)
(SETQ TSEL (OR SEL (fetch SEL of TEXTOBJ)))
(SETQ LEN (fetch DCH of TSEL))
(COND
((ZEROP LEN) (* There is no selection, or it's zero-width.
Return "")
(RETURN ""))
(T (SETQ RESULT (ALLOCSTRING LEN (CHARCODE SPACE)))
(* The resulting string)
(\SETUPGETCH (fetch CH# of TSEL)
TEXTOBJ) (* Starting point for the string is start of
selection.)
(for I from 1 to LEN
do (* Get chars from the stream, and put them in the
string.)
(RPLCHARCODE RESULT I (\GETCH TEXTOBJ)))
(RETURN RESULT])
(TEDIT.SELECTED.PIECES
[LAMBDA (TEXTOBJ SEL CROSSCOPY PIECEMAPFN FNARG1 FNARG2) (* jds " 6-Mar-85 22:10")
(* Create a list of pieces corresponding to the selection; if FNARG, apply it to each piece, and use the result as
the copy of the piece)
(PROG ((CH1 (fetch CH# of SEL))
(CHLIM (fetch CHLIM of SEL))
(PCTB (fetch PCTB of TEXTOBJ))
LEN INSPC INSPC# PC NPC PCCH NPCCH OPLEN EVENT REPLACING INSERTCH# PCLST OBJ COPYFN
UNDOCHAIN) (* Find the insertion point)
(SETQ PCLST (TCONC NIL))
[for I from \FirstPieceOffset to (IDIFFERENCE (\EDITELT PCTB \PCTBLastPieceOffset)
\EltsPerPiece)
by \EltsPerPiece
do (* Gather a list of pieces to be copied)
(SETQ PCCH (\EDITELT PCTB I)) (* CH# for this piece)
(SETQ PC (\EDITELT PCTB (ADD1 I))) (* The piece itself)
(SETQ NPCCH (\EDITELT PCTB (IPLUS I \EltsPerPiece)))
(* Next piece's CH#)
(COND
((ILEQ NPCCH CH1) (* The current piece isn't inside the region to be
copied.)
)
((IGEQ PCCH CHLIM) (* We've passed beyond the copy region.
Bail out.)
(RETURN))
(T (* This piece overlaps the copy-source region of the
document)
(* Add it to the copy list.)
[COND
((ILESSP PCCH CH1) (* The piece overlaps the bottom of the copy region:
Chop off its front part.)
(SETQ PC (\SPLITPIECE PC CH1 TEXTOBJ I))
(add I \EltsPerPiece)
(SETQ PCTB (fetch PCTB of TEXTOBJ]
[COND
((ILESSP CHLIM NPCCH) (* This piece overlaps the end of the copy region.
Shorten it at the end.)
(\SPLITPIECE PC CHLIM TEXTOBJ I)
(SETQ PCTB (fetch PCTB of TEXTOBJ]
(TCONC PCLST (SETQ NPC (COND
(PIECEMAPFN (APPLY* PIECEMAPFN PC TEXTOBJ FNARG1 FNARG2))
(T PC]
(RETURN (CDAR PCLST])
(\TEDIT.FIND.FIRST.LINE
[LAMBDA (TEXTOBJ WHEIGHT CH# WINDOW) (* jds "21-Nov-84 11:18")
(* Find the first line to be displayed, given that it
must include character CH#)
(PROG ((LINES (OR (AND WINDOW (WINDOWPROP WINDOW (QUOTE LINES)))
(fetch LINES of TEXTOBJ)))
(WWIDTH (fetch WRIGHT of TEXTOBJ))
(TEXTSTREAM (fetch STREAMHINT of TEXTOBJ))
LINE CHNO CH)
[COND
((ZEROP (fetch TEXTLEN of TEXTOBJ)) (* If there's no text, force an empty line)
(SETQ CHNO 1)
(replace NEXTLINE of LINES with NIL)
(RETURN LINES))
((IGREATERP CH# (fetch TEXTLEN of TEXTOBJ)) (* If there's no text on the screen, just return nil)
(RETURN NIL))
[(fetch FORMATTEDP of TEXTOBJ) (* For a para-formatted object, back up to the prior
para bound.)
(SETQ CHNO (CAR (\TEDIT.PARABOUNDS TEXTOBJ CH#]
(T (* Otherwise, move back thru the text until we find a
for-sure line break)
(\SETUPGETCH CH# TEXTOBJ)
(SETQ CH 0)
(for old CHNO from (SUB1 CH#) to 2 by -1 repeatwhile (NOT (EQ CH (CHARCODE CR)))
do (SETQ CH (\BACKBIN TEXTSTREAM)))
(SETQ CHNO (COND
((ILEQ CHNO 1) (* If we moved back to start-of-file, move forward from
there;)
1)
((IEQP CHNO CH#) (* If we landed on a CR first shot, let's try moving
forward from there.)
CH#)
(T (* Else, skip the CR we passed over)
(ADD1 CHNO]
(SETQ CH# (IMIN CH# (fetch TEXTLEN of TEXTOBJ)))
[repeatwhile (ILEQ CHNO CH#)
do (* Starting from the known line break, move forward
until we find the line which has the right CH# in it)
(SETQ LINE (\FORMATLINE TEXTOBJ NIL CHNO))
(replace YBOT of LINE with WHEIGHT)
(replace NEXTLINE of LINES with LINE)
(replace PREVLINE of LINE with LINES)
(SETQ LINES LINE)
(SETQ CHNO (ADD1 (fetch CHARLIM of LINE]
(RETURN LINE])
(\TEDIT.FIND.LAST.LINE
[LAMBDA (TEXTOBJ LINES) (* jds "21-Aug-84 12:16")
(* Among the line descriptors in LINES, find the last
one on the screen; then return it.)
(OR LINES (SETQ LINES (fetch LINES of TEXTOBJ))) (* Make sure a list of line descriptors is specified.)
(COND
((fetch \WINDOW of TEXTOBJ) (* If there's no window, return NIL.)
(bind (OLINE ← LINES)
(LINE ← LINES)
(CURY ←(fetch YBOT of LINES)) while (AND LINE (IGEQ (fetch YBOT of LINE)
(fetch WBOTTOM of TEXTOBJ)))
do (* Find the lowest line above screen bottom, and put it
in OLINE.)
(SETQ OLINE LINE)
(SETQ LINE (fetch NEXTLINE of LINE))
finally (RETURN OLINE)))
(T NIL])
(\TEDIT.FIND.OVERLAPPING.LINE
[LAMBDA (LINES Y) (* jds " 9-Dec-83 17:17")
(while LINES do (COND
((ILEQ (fetch YBOT of LINES)
Y)
(RETURN LINES))
(T (SETQ LINES (fetch NEXTLINE of LINES])
(\TEDIT.FIND.PROTECTED.END
[LAMBDA (TEXTOBJ CH# LIMITCH#) (* jds " 9-Jan-85 13:25")
(* Starting from a CH# in a selectable region, find the CH# of the last selectable character following that.
This is used to limit selections to unprotected text, and to prevent selection of the protected text between tow
unprotected areas.)
(* If LIMITCH# is given, the search will stop there.)
(bind (OURLIMIT ←(IMIN (OR LIMITCH# (fetch TEXTLEN of TEXTOBJ))
(fetch TEXTLEN of TEXTOBJ)))
(PCTB ←(fetch PCTB of TEXTOBJ)) for I from (ADD1 (\CHTOPCNO CH# (fetch PCTB of TEXTOBJ)))
to (\EDITELT (fetch PCTB of TEXTOBJ)
\PCTBLastPieceOffset)
by \EltsPerPiece
do
(* Move forward thru the pieces of the document, looking for one that contains protected text.
If that comes before the end of the region we're interested in, tell the caller about the earlier end to selectable
text.)
(COND
((IGREATERP (\EDITELT PCTB (SUB1 I))
OURLIMIT) (* We've passed the limit, so it's time to give up.
Just return the LIMITCH#)
(RETURN OURLIMIT))
((fetch CLPROTECTED of (fetch PLOOKS of (\EDITELT PCTB I)))
(* We've found the beginning of a protected region --
i.e., the end of the selectable region.
Tell the caller about it.)
(RETURN (SUB1 (\EDITELT PCTB (SUB1 I])
(\TEDIT.FIND.PROTECTED.START
[LAMBDA (TEXTOBJ CH# LIMITCH#) (* jds " 5-Feb-85 14:47")
(* Starting from a CH# in a selectable region, find the CH# of the earliest contiguously-selectable character
preceding that. This is used to limit selections to unprotected text, and to prevent selection of the protected text
between tow unprotected areas.)
(* Will stop looking when it passes LIMITCH#, or at the
beginning of the document.)
(bind (OURLIMIT ←(OR LIMITCH# 1))
(PCTB ←(fetch PCTB of TEXTOBJ)) for I
from (ADD1 (\CHTOPCNO (IMAX 1 (IMIN CH# (fetch TEXTLEN of TEXTOBJ)))
(fetch PCTB of TEXTOBJ)))
to \FirstPieceOffset by (IMINUS \EltsPerPiece) do (COND
((ILEQ (\EDITELT PCTB (SUB1 I))
OURLIMIT)
(* If he specified a LIMITCH#, and we have passed it,
stop bothering and return the LIMITCH#)
(RETURN OURLIMIT))
((fetch CLPROTECTED
of (fetch PLOOKS
of (\EDITELT PCTB I)))
(* We hit a PROTECTED piece of text.
This is the place to stop. Return the CH# just AFTER
the protected text we found.)
(RETURN (\EDITELT PCTB (ADD1 I])
(\TEDIT.WORD.BOUND
[LAMBDA (TEXTOBJ PREVCH CH) (* jds "24-Jan-84 14:11")
(PROG ((READSA (fetch READSA of (OR (fetch TXTWTBL of TEXTOBJ)
TEDIT.WORDBOUND.READTABLE)))
SYN1 SYN2)
(COND
((NOT (AND (FIXP PREVCH)
(FIXP CH)))
(RETURN T)))
(SETQ SYN1 (\SYNCODE READSA PREVCH))
(SETQ SYN2 (\SYNCODE READSA CH))
(RETURN (NEQ SYN1 SYN2])
)
(FILESLOAD TEXTOFD)
(DECLARE: EVAL@COMPILE
(RPAQQ COPYSELSHADE 30583)
(RPAQQ COPYLOOKSSELSHADE 30583)
(RPAQQ EDITMOVESHADE -1)
(RPAQQ EDITGRAY 32800)
(CONSTANTS (COPYSELSHADE 30583)
(COPYLOOKSSELSHADE 30583)
(EDITMOVESHADE -1)
(EDITGRAY 32800))
)
(RPAQ? TEDIT.EXTEND.PENDING.DELETE T)
(RPAQ TEDIT.SELECTION (create SELECTION))
(RPAQ TEDIT.SCRATCHSELECTION (create SELECTION))
(RPAQ TEDIT.SHIFTEDSELECTION (create SELECTION HOW←COPYSELSHADE HASCARET←NIL))
(RPAQ TEDIT.COPYLOOKSSELECTION (create SELECTION HOW←COPYLOOKSSELSHADE HASCARET←NIL))
(RPAQ TEDIT.MOVESELECTION (CREATE SELECTION HOW←EDITMOVESHADE HASCARET←NIL HOWHEIGHT←32767))
(RPAQ TEDIT.DELETESELECTION (CREATE SELECTION HOW←BLACKSHADE HASCARET←NIL HOWHEIGHT←32767))
(RPAQQ SELECTION NOBIND)
(RPAQQ SELECTION NOBIND)
(RPAQQ TEDIT.SELPENDING NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.SELECTION TEDIT.SCRATCHSELECTION TEDIT.MOVESELECTION TEDIT.SHIFTEDSELECTION
TEDIT.COPYLOOKSSELECTION TEDIT.DELETESELECTION TEDIT.SELPENDING
TEDIT.EXTEND.PENDING.DELETE)
)
(* Selection manipulating code)
(DEFINEQ
(TEDIT.EXTEND.SEL
[LAMBDA (X Y OSEL TEXTOBJ SELOPERATION SELWINDOW NEWSEL) (* jds " 7-Mar-85 02:48")
(* Gather a new selected character, and extend OSEL to
include it. Return the extended selection.)
(PROG ((NSEL (OR NEWSEL (TEDIT.SELECT X Y TEXTOBJ (SELECTQ (fetch SELKIND of OSEL)
((LINE PARA)
(QUOTE LINE))
((WORD CHAR)
(QUOTE TEXT))
(QUOTE TEXT))
(OR (EQ (fetch SELKIND of OSEL)
(QUOTE WORD))
(EQ (fetch SELKIND of OSEL)
(QUOTE PARA)))
SELOPERATION SELWINDOW)))
(TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(NPOINT NIL)
(SETOSELFLG NIL)
(FIXUPNEEDED NIL))
(COND
((ZEROP TEXTLEN) (* No sense in extending a selection if there's no
text!)
(RETURN NSEL)))
(COND
((AND NSEL (fetch SET of NSEL)) (* If there's no second selection, don't bother trying)
(\TEDIT.SET.SEL.LOOKS NSEL SELOPERATION) (* Make the new selection be the same kind as the
original, as to what it's for -- regular, copy-source,
etc.)
[SETQ NPOINT (COND
((IGEQ (fetch CHLIM of NSEL)
(fetch CHLIM of OSEL)) (* The new selection ends to the right of the old one.
Move this edge.)
(QUOTE RIGHT))
((ILEQ (fetch CH# of NSEL)
(fetch CH# of OSEL)) (* If the new selection starts to left of old one,
caret goes at the LEFT)
(QUOTE LEFT))
([IGREATERP (IABS (IDIFFERENCE (fetch CHLIM of NSEL)
(fetch CHLIM of OSEL)))
(IABS (IDIFFERENCE (fetch CH# of NSEL)
(fetch CH# of OSEL]
(SETQ SETOSELFLG T)
(QUOTE LEFT))
(T (SETQ SETOSELFLG T)
(QUOTE RIGHT]
[SELECTQ NPOINT
[LEFT (* Caret's to the left. Keep the same right end)
[replace CHLIM of NSEL
with (IMAX (fetch CHLIM of NSEL)
(SELECTQ (fetch POINT of OSEL)
(LEFT (IPLUS (fetch CH# of OSEL)
(fetch DCH of OSEL)))
(RIGHT (fetch CHLIM of OSEL))
(SHOULDNT]
(replace XLIM of NSEL with (fetch XLIM of OSEL))
(replace YLIM of NSEL with (fetch YLIM of OSEL))
(replace LN of NSEL with (COPY (fetch LN of OSEL)))
(COND
((NEQ SELOPERATION (QUOTE COPY))
(* The old sel is in a protected area.
Only let him extend to the start of it.)
[replace CH# of NSEL
with (IMAX (fetch CH# of NSEL)
(\TEDIT.FIND.PROTECTED.START TEXTOBJ
(SUB1 (fetch CHLIM
of OSEL))
(fetch CH# of NSEL]
(SETQ FIXUPNEEDED T) (* Note that the L1/LN may be invalid as a result of
this contraction. Force a \FIXSEL later.)
]
[RIGHT (* Point's to the right; keep the same left end.)
[replace CH# of NSEL
with (IMIN (fetch CH# of NSEL)
(SELECTQ (fetch POINT of OSEL)
(LEFT (fetch CH# of OSEL))
(RIGHT (IDIFFERENCE (fetch CHLIM of OSEL)
(fetch DCH of OSEL)))
(SHOULDNT]
(replace X0 of NSEL with (fetch X0 of OSEL))
(replace Y0 of NSEL with (fetch Y0 of OSEL))
(replace L1 of NSEL with (COPY (fetch L1 of OSEL)))
(COND
((NEQ SELOPERATION (QUOTE COPY))
(* The old sel is in a protected area.
Only let him extend to the start of it.)
[replace CHLIM of NSEL
with (IMIN (fetch CHLIM of NSEL)
(ADD1 (\TEDIT.FIND.PROTECTED.END
TEXTOBJ
(fetch CH# of OSEL)
(ADD1 (\TEDIT.FIND.PROTECTED.END
TEXTOBJ
(fetch CH# of OSEL)
(SUB1 (fetch CHLIM of NSEL]
(replace CH# of NSEL with (IMIN (fetch CHLIM of NSEL)
(fetch CH# of NSEL)))
(SETQ FIXUPNEEDED T) (* Note that the L1/LN may be invalid as a result of
this contraction. Force a \FIXSEL later.)
]
(PROGN (replace CHLIM of NSEL with (fetch CHLIM of OSEL))
(replace XLIM of NSEL with (fetch XLIM of OSEL))
(replace YLIM of NSEL with (fetch YLIM of OSEL))
(replace LN of NSEL with (COPY (fetch LN of OSEL)))
(replace CH# of NSEL with (fetch CH# of OSEL))
(replace X0 of NSEL with (fetch X0 of OSEL))
(replace Y0 of NSEL with (fetch Y0 of OSEL))
(replace L1 of NSEL with (COPY (fetch L1 of OSEL)))
(SETQ NPOINT (fetch POINT of OSEL]
(replace DCH of NSEL with (IDIFFERENCE (IMIN (ADD1 TEXTLEN)
(fetch CHLIM of NSEL))
(fetch CH# of NSEL)))
(* The selection's length cannot exceed that of the
whole text.)
(replace CHLIM of NSEL with (IPLUS (fetch CH# of NSEL)
(fetch DCH of NSEL)))
(* This assures that the CHLIM corresponds to the DCH.)
(replace POINT of NSEL with NPOINT)
(replace (SELECTION DX) of NSEL with (IDIFFERENCE (fetch XLIM of NSEL)
(fetch X0 of NSEL)))
(COND
((NEQ (fetch SELOBJ of OSEL)
(fetch SELOBJ of NSEL))
(replace SELOBJ of NSEL with NIL)))
(COND
(FIXUPNEEDED (* We're in a menu, and this selection got contracted
because of a protection violation.
Fix up everything.)
(\FIXSEL NSEL TEXTOBJ)))
(COND
(SETOSELFLG (* For whatever reason, it is wise to copy the new sel
into the old one.)
(\COPYSEL NSEL OSEL))
(T (* Otherwise, set the POINT of the old sel to
correspond to the new sel's.)
(* (replace POINT of OSEL with NPOINT))
(* THIS WAS REMOVED, BECAUSE EXTENDING A
POINT-SELECTION WOULD DIE WHEN THIS WAS DONE)
))
(RETURN NSEL))
(T (* No new selection was made;
just return the old one.)
(RETURN OSEL])
(TEDIT.SELECT
[LAMBDA (X Y TEXTOBJ REGION WORDSELFLG SELOPERATION WINDOW)
(* jds "11-Sep-85 14:07")
(* Select the character word, line, or paragraph the
mouse is pointing at.)
(PROG ((SEL NIL)
(TEXTLEN (fetch TEXTLEN of TEXTOBJ))
PREVLINE L1 LN)
(SETQ SEL (TEDIT.SELECT.LINE.SCANNER X Y TEXTOBJ (\TEDIT.LINE.LIST TEXTOBJ WINDOW)
REGION WORDSELFLG SELOPERATION WINDOW))
(COND
((AND (type? SELECTION SEL)
(fetch SET of SEL)) (* He pointed at something real;
return that.)
(\TEDIT.SET.SEL.LOOKS SEL SELOPERATION)
[COND
([AND (CAR (fetch L1 of SEL))
(fetch FMTHARDCOPY of (fetch LFMTSPEC of (CAR (fetch L1 of SEL]
(replace X0 of SEL with (FIXR (FQUOTIENT (fetch X0 of SEL)
35.27778]
[COND
([AND (CAR (fetch LN of SEL))
(fetch FMTHARDCOPY of (fetch LFMTSPEC of (CAR (fetch LN of SEL]
(replace XLIM of SEL with (FIXR (FQUOTIENT (fetch XLIM of SEL)
35.27778]
(replace DX of SEL with (IDIFFERENCE (fetch XLIM of SEL)
(fetch X0 of SEL)))
(\FIXSEL SEL TEXTOBJ WINDOW T)
(RETURN SEL))
((type? LINEDESCRIPTOR SEL) (* He pointed below the bottom of the text.
Select to the right of the last character on the
screen.)
(COND
((fetch LHASPROT of SEL) (* The last line is protected.
Don't select anything.)
(RETURN)))
(SETQ PREVLINE SEL)
(SETQ SEL (fetch SCRATCHSEL of TEXTOBJ))
(replace SET of SEL with T)
(replace \TEXTOBJ of SEL with TEXTOBJ)
[replace CH# of SEL with (IMAX 1 (ADD1 (IMIN TEXTLEN (fetch CHARLIM of PREVLINE]
(replace CHLIM of SEL with (fetch CH# of SEL))
(replace DCH of SEL with 0)
[replace POINT of SEL with (COND
((IGREATERP (fetch CH# of SEL)
(fetch TEXTLEN of TEXTOBJ))
(* Can't select to the right of a character past EOF,
only to the left -- which is the right edge of the
text.)
(QUOTE LEFT))
(T (QUOTE RIGHT]
(\TEDIT.SET.SEL.LOOKS SEL SELOPERATION)
(\FIXSEL SEL TEXTOBJ)
(RETURN SEL])
(TEDIT.SCAN.LINE
[LAMBDA (TEXTOBJ LINE THISLINE X Y WORDSELFLG SELOPERATION WINDOW)
(* jds "31-Jul-85 19:53")
(* Given a line, find the character which straddles the
mouse.)
(PROG ((L NIL)
(WLIST (fetch (THISLINE WIDTHS) of THISLINE))
(CHLIST (fetch (THISLINE CHARS) of THISLINE))
(LLIST (fetch (THISLINE LOOKS) of THISLINE))
(LOOKNO 1)
(DX 0)
OTX YBOT YBASE TX (CH (CHARCODE SPACE))
PREVCH CHOBJB TXB CHB (TEXTLEN (fetch TEXTLEN of TEXTOBJ))
L1 LN CLOOKS PCLOOKS)
(COND
((NEQ (fetch DESC of THISLINE)
LINE) (* If the cache doesn't describe this line, call
\FORMATLINE so it will.)
(\FORMATLINE TEXTOBJ NIL (fetch CHAR1 of LINE)
LINE)))
[COND
((fetch FMTHARDCOPY of (fetch LFMTSPEC of LINE))
(* This is a hardcopy-mode line.
Convert units to micas)
(SETQ X (FIXR (FTIMES X 35.27778]
[SETQ OTX (SETQ TXB (SETQ TX (fetch LEFTMARGIN of LINE]
(SETQ X (IMAX X TX)) (* The mouse MUST be inside the line being selected.)
(SETQ CHB (SUB1 (fetch CHAR1 of LINE)))
(SETQ CLOOKS (\EDITELT LLIST 0))
(\TEDIT.CHECK (IGEQ X (fetch LEFTMARGIN of LINE)))
(* The mouse MUST be inside the line being selected.)
(for I from 0 to (fetch LEN of THISLINE) as CHNO from (SUB1 (fetch CHAR1 of LINE))
do (SETQ PREVCH CH)
(SETQ PCLOOKS CLOOKS)
(SETQ CH (\EDITELT CHLIST I))
[COND
((EQ CH LMInvisibleRun) (* An invisible run -- skip it)
(add CHNO (\EDITELT LLIST LOOKNO)) (* The length of the run)
(add LOOKNO 1) (* Move to next CLook for next transition)
(add I 1) (* Don't count this toward the CHNO counter.)
(SETQ CH (\EDITELT CHLIST I]
(\TEDIT.CHECK (NEQ CH LMInvisibleRun)) (* Can't have 2 invisible runs in a row.)
[COND
((EQ CH LMLooksChange) (* Change of CharLooks -- make the switch)
(SETQ CLOOKS (\EDITELT LLIST LOOKNO)) (* New looks)
(add LOOKNO 1) (* Move to next CLook for next transition)
(add I 1) (* Don't count this toward the CHNO counter.)
(SETQ CH (\EDITELT CHLIST I]
[COND
((AND (ILESSP X TX)
(OR (EQ SELOPERATION (QUOTE COPY))
(fetch CLSELHERE of PCLOOKS)
(NOT (fetch CLPROTECTED of PCLOOKS)))
(OR (NOT WORDSELFLG)
(NOT (SMALLP PREVCH))
(\TEDIT.WORD.BOUND TEXTOBJ PREVCH CH)))
(* If we're beyond the mouse's X, and the character is selectable, and we're in char select or this is a word
boundary then SELECT!!!)
(\TEDIT.CHECK (NOT (ZEROP I))) (* We had best not have fouled out to the left of the
left margin!)
(SETQ L (fetch SCRATCHSEL of TEXTOBJ)) (* Grab the scratch sel)
(replace SET of L with T) (* Mark it valid)
[replace SELKIND of L with (COND
(WORDSELFLG (QUOTE WORD))
(T (QUOTE CHAR]
(\TEDIT.SELECT.CHARACTER TEXTOBJ L PREVCH LINE X Y TXB WINDOW)
(replace Y0 of L with (fetch YBOT of LINE))
(replace X0 of L with (COND
((fetch CLSELHERE of PCLOOKS)
(* If CLSelHere, then select to RIGHT always.)
TX)
(WORDSELFLG TXB)
(T OTX)))
(replace (SELECTION DX) of L with (COND
((fetch CLSELHERE of PCLOOKS)
0)
(WORDSELFLG (IDIFFERENCE TX TXB))
(T DX)))
[replace CH# of L with (IMAX 1 (COND
((fetch CLSELHERE of PCLOOKS)
(ADD1 CHNO))
(WORDSELFLG (ADD1 CHB))
(T CHNO]
(replace XLIM of L with (COND
((fetch CLSELHERE of PCLOOKS)
TX)
(WORDSELFLG TX)
(T TX)))
[replace CHLIM of L with (ADD1 (COND
((fetch CLSELHERE of PCLOOKS)
CHNO)
(WORDSELFLG CHNO)
(T CHNO]
(replace YLIM of L with (fetch YBOT of LINE))
(for L1 on (fetch L1 of L) as LN on (fetch LN of L) as WW
inside (fetch \WINDOW of TEXTOBJ) when (EQ WW WINDOW)
do (RPLACA L1 LINE)
(RPLACA LN LINE))
[replace POINT of L with (COND
((fetch CLSELHERE of PCLOOKS)
(* Always to the right of an otherwise-protected
insertion point marker)
(QUOTE RIGHT))
[WORDSELFLG (COND
((AND (NEQ PREVCH (CHARCODE CR))
(IGEQ X (LRSH (IPLUS TX TXB)
1)))
(* To the right if it isn't a CR and we're right of
center.)
(QUOTE RIGHT))
(T (QUOTE LEFT]
(T (COND
((AND (IGEQ DX 3)
(NEQ PREVCH (CHARCODE CR))
(IGEQ X (LRSH (IPLUS TX OTX)
1)))
(* If it's wide enough to sensibly decide on an edge for, this isn't a CR, and we're right of center, then put the
caret to the RIGHT)
(QUOTE RIGHT))
(T (QUOTE LEFT]
(replace DCH of L with (COND
((fetch CLSELHERE of PCLOOKS)
0)
(WORDSELFLG (IDIFFERENCE CHNO CHB))
(T 1)))
(RETURN))
(T (* We're not past the mouse yet;
just track the last word boundary
(or protected-text boundary) for word selection.)
(COND
((OR (AND (NOT (fetch CLPROTECTED of CLOOKS))
(\TEDIT.WORD.BOUND TEXTOBJ PREVCH CH))
(NEQ (fetch CLPROTECTED of PCLOOKS)
(fetch CLPROTECTED of CLOOKS))
(fetch CLSELHERE of PCLOOKS))
(SETQ TXB TX)
(SETQ CHB CHNO)
(SETQ CHOBJB PREVCH]
(SETQ OTX TX)
(SETQ DX (\WORDELT WLIST I))
(SETQ TX (IPLUS TX DX)))
[COND
((AND (NOT L)
(IGEQ (fetch LEN of THISLINE)
0)
(fetch CLPROTECTED of CLOOKS)) (* He's pointing to the right of the line, but there's
protected text at the end. Select a point at the last
legal spot.)
(COND
((SMALLP CHOBJB) (* And the last item wasn't a menu button)
(SETQ L (fetch SCRATCHSEL of TEXTOBJ))
(replace SET of L with T)
(replace Y0 of L with (fetch YBOT of LINE))
(replace X0 of L with TXB)
(replace (SELECTION DX) of L with 0)
(replace CH# of L with (IMAX 1 (ADD1 CHB)))
(replace XLIM of L with TXB)
(replace CHLIM of L with (IMAX 1 (ADD1 CHB)))
(replace YLIM of L with (fetch YBOT of LINE))
(for L1 on (fetch L1 of L) as LN on (fetch LN of L) as WW
inside (fetch \WINDOW of TEXTOBJ) when (EQ WW WINDOW)
do (RPLACA L1 LINE)
(RPLACA LN LINE))
(replace POINT of L with (QUOTE LEFT))
(replace DCH of L with 0)
(replace SELOBJ of L with NIL))
(T (* Oops--the last item WAS a menu button.
Don't let it be selected.)
(RETURN (QUOTE DON'T]
(COND
(L (* If we found the place he's pointing, set up the
inter-pointers so each can find the other)
(replace \TEXTOBJ of L with TEXTOBJ))
(T (* We didn't find what he was pointing at.
Point to the end of the line.)
(SETQ L (fetch SCRATCHSEL of TEXTOBJ))
(replace SET of L with T)
[replace SELKIND of L with (COND
(WORDSELFLG (QUOTE WORD))
(T (QUOTE CHAR]
(* THIS MUST PRECEDE THE \TEDIT.SELECT.CHARACTER, SO
OBJECTS CAN TURN THE SELECTION VOLATILE.)
(\TEDIT.SELECT.CHARACTER TEXTOBJ L CH LINE X Y TXB WINDOW)
(replace Y0 of L with (fetch YBOT of LINE))
[replace X0 of L with (COND
(WORDSELFLG TXB)
(T (IDIFFERENCE TX DX]
(replace XLIM of L with TX)
(replace (SELECTION DX) of L with (COND
(WORDSELFLG (IDIFFERENCE TX TXB))
(T DX)))
[replace CH# of L with (COND
(WORDSELFLG (ADD1 CHB))
(T (IMIN (fetch CHARLIM of LINE)
TEXTLEN]
(replace YLIM of L with (fetch YBOT of LINE))
(replace CHLIM of L with (ADD1 (IMIN (fetch CHARLIM of LINE)
TEXTLEN)))
[replace POINT of L with (COND
[(NEQ CH (CHARCODE CR))
(* You can select only to the left of a CR;
elsewhere, you can select to the right)
(COND
([IGEQ X (COND
(WORDSELFLG
(* If it's a word, check our location against mid-word
to see which side to put the caret on)
(LRSH (IPLUS TX TXB)
1))
(T (* Otherwise, check against mid-character)
(IDIFFERENCE TX (LRSH DX 1]
(* If we're to the right of mid-item, put the caret on
the right.)
(QUOTE RIGHT))
(T (* Otherwise, put it on the left.)
(QUOTE LEFT]
(T (QUOTE LEFT]
(for L1 on (fetch L1 of L) as LN on (fetch LN of L) as WW
inside (fetch \WINDOW of TEXTOBJ) when (EQ WW WINDOW)
do (RPLACA L1 LINE)
(RPLACA LN LINE))
(replace DCH of L with (COND
(WORDSELFLG (IDIFFERENCE (IMIN (fetch CHARLIM of LINE)
TEXTLEN)
CHB))
(T 1)))
(replace \TEXTOBJ of L with TEXTOBJ)))
(RETURN L])
(TEDIT.SELECT.LINE.SCANNER
[LAMBDA (X Y TEXTOBJ LINE.LIST REGION WORDSELFLG SELOPERATION WINDOW)
(* jds "16-Jul-85 17:19")
(* Find the text line the mouse is pointing at.)
(* LINE.LIST is the dummy first line for the window in
which selection happened.)
(PROG ((L NIL)
(WWIDTH (fetch WRIGHT of TEXTOBJ))
(THISLINE (fetch THISLINE of TEXTOBJ))
(TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(WREG (DSPCLIPPINGREGION NIL WINDOW))
PREVLINE PARABOUNDS PARASTART PARAEND L1 LN)
(bind (LINE ←(fetch NEXTLINE of LINE.LIST)) while (AND LINE (IGEQ (fetch YBOT of LINE)
(fetch BOTTOM
of WREG)))
do
(* Search thru the list of (real) displayed lines, looking for the first one whose bottom is below the mouse.
That's the line we're pointing at.)
(COND
((ILEQ (fetch YBOT of LINE)
Y) (* Found it.)
(SELECTQ
REGION
((TEXT WINDOW) (* We're in the regular text area, so scan accross
looking for the character.)
(SETQ L (TEDIT.SCAN.LINE TEXTOBJ LINE THISLINE X Y WORDSELFLG SELOPERATION
WINDOW)))
[LINE (* He is selecting an entire line, or a paragraph.)
(SETQ L (fetch SCRATCHSEL of TEXTOBJ))
(for TL1 on (fetch L1 of L) as TLN on (fetch LN of L) as WW
inside (fetch \WINDOW of TEXTOBJ) when (EQ WW WINDOW)
do (SETQ L1 TL1)
(SETQ LN TLN)
(RETURN))
(COND
((AND (fetch LHASPROT of LINE)
(NEQ SELOPERATION (QUOTE COPY)))
(* In a TEDIT menu, you can't select a whole paragraph
or line.)
(replace SET of L with NIL)
(RETURN L))) (* The scratch selection)
(replace \TEXTOBJ of L with TEXTOBJ)
(* Make sure he knows what document the selection's
in.)
(replace SET of L with T) (* Mark it valid.)
(replace SELOBJ of L with NIL) (* Not selecting an object just yet)
(COND
[WORDSELFLG (* Select a paragraph.)
(replace SELKIND of L with (QUOTE PARA))
(* SEARCH FORWARD FROM THE CURRENT LINE TO A LINE WITH
A CR OR CHARLIM=EOTEXT)
[COND
((fetch FORMATTEDP of TEXTOBJ)
(* If this is a para-formatted document, use the
paragraph bounds. Otherwise, delimit a para by the
surrounding CRs.)
(SETQ PARABOUNDS (\TEDIT.PARABOUNDS TEXTOBJ (fetch CHAR1
of LINE)))
(SETQ PARASTART (\TEDIT.FIND.PROTECTED.START TEXTOBJ
(fetch CHAR1
of LINE)
(CAR PARABOUNDS)))
(SETQ PARAEND (\TEDIT.FIND.PROTECTED.END TEXTOBJ
(fetch CHAR1 of LINE)
(CDR PARABOUNDS]
(RPLACA L1 LINE)
(RPLACA LN LINE)
(bind (LL ← LINE) while (AND [COND
((fetch FORMATTEDP of TEXTOBJ)
(ILESSP (fetch CHARLIM of LL)
PARAEND))
(T (NOT (fetch CR\END of LL]
(ILESSP (fetch CHARLIM of LL)
TEXTLEN))
do (* Walk forward thru the lines, looking for the last
line in the paragraph.)
[COND
((fetch NEXTLINE of LL)
(SETQ LL (fetch NEXTLINE of LL)))
(T [replace NEXTLINE of LL
with (\FORMATLINE TEXTOBJ NIL
(ADD1 (fetch CHARLIM of LL]
(replace PREVLINE of (fetch NEXTLINE of LL) with LL)
(SETQ LL (fetch NEXTLINE of LL]
finally (RPLACA LN LL)) (* SEARCH BACK TO A LINE WITH A CR OR BOTEXT)
[COND
((IGREATERP (fetch CHAR1 of LINE)
1) (* Only search backward if we're not on the first line
already.)
(bind (LL ← LINE)
while [AND (IGREATERP (fetch CHAR1 of LL)
1)
(COND
((fetch FORMATTEDP of TEXTOBJ)
(IGREATERP (fetch CHAR1 of LL)
PARASTART))
(T (NOT (fetch CR\END of (fetch PREVLINE
of LL]
do
(* Back up until we find the first line of the paragraph, or we hit the dummy top line (which claims to end in CR.))
(SETQ LL (fetch PREVLINE of LL))
finally (RPLACA L1
(COND
((AND (fetch FORMATTEDP of TEXTOBJ)
(IEQP (fetch CHAR1 of LL)
PARASTART))
(* We found a true start of para.)
LL)
([AND (fetch PREVLINE of LL)
(NOT (ZEROP (fetch CHARLIM
of (fetch PREVLINE
of LL]
(* We hit the first line in the paragraph, fair and
square)
LL)
((IEQP 1 (fetch CHAR1 of LL))
(* We hit the front of the document.)
LL)
(T (\BACKFORMAT LINE.LIST TEXTOBJ
(fetch PTOP of WREG))
(fetch NEXTLINE of LINE.LIST]
[replace CH# of L with (OR PARASTART (fetch CHAR1 of (CAR L1]
[replace CHLIM of L with (ADD1 (OR PARAEND (fetch CHARLIM
of (CAR LN]
(replace POINT of L with (QUOTE LEFT))
(replace DCH of L with (IDIFFERENCE (fetch CHLIM of L)
(fetch CH# of L)))
(COND
((fetch LHASPROT of LINE) (* We have cause to suspect there may be protected text
around this para. Fix the sel the hard way.)
(\FIXSEL L TEXTOBJ))
(T (* No protected text is evident.
DO it the easy way.)
(replace Y0 of L with (fetch YBOT of (CAR L1)))
(replace YLIM of L with (fetch YBOT of (CAR LN)))
(replace X0 of L with (fetch LEFTMARGIN of (CAR L1)))
(replace XLIM of L with (fetch LXLIM of (CAR LN)))
(replace (SELECTION DX) of L
with (IPLUS 1 (IDIFFERENCE (fetch XLIM of L)
(fetch X0 of L]
(T (* Select the line we're pointing at.)
(replace SELKIND of L with (QUOTE LINE))
(RPLACA L1 LINE)
(RPLACA LN LINE)
(replace CH# of L with (fetch CHAR1 of LINE))
(replace CHLIM of L with (ADD1 (fetch CHARLIM of LINE)))
(replace (SELECTION DX) of L with (IDIFFERENCE (fetch LXLIM
of LINE)
(fetch LEFTMARGIN
of LINE)))
(replace X0 of L with (fetch LEFTMARGIN of LINE))
(replace XLIM of L with (fetch LXLIM of LINE))
(replace Y0 of L with (replace YLIM of L with (fetch YBOT
of LINE)))
(replace DCH of L with (IDIFFERENCE (fetch CHLIM of L)
(fetch CH# of L)))
(replace POINT of L with (QUOTE LEFT))
(replace SET of L with T]
(SHOULDNT "Unknown text/line-bar region?"))
(RETURN)))
(SETQ PREVLINE LINE)
(SETQ LINE (fetch NEXTLINE of LINE)))
(RETURN (OR L PREVLINE])
(\TEDIT.SELECT.CHARACTER
[LAMBDA (TEXTOBJ SEL PREVCH LINE X Y TXB SELWINDOW) (* jds "16-May-85 13:20")
(* We have moved over a particular character.
If it's really a character, OK.
Otherwise, call in the selection function!)
(DECLARE (USEDFREE . WORDSELFLG))
(COND
((SMALLP PREVCH)
(replace SELOBJ of SEL with NIL))
(T (replace (SELECTION SELOBJ) of SEL with PREVCH)
(replace (SELECTION X0) of SEL with TXB)
(replace (SELECTION Y0) of SEL with (fetch YBOT of LINE))
[PROG ([OBJBOX (OR (IMAGEOBJPROP PREVCH (QUOTE BOUNDBOX))
(IMAGEBOX PREVCH SELWINDOW (QUOTE DISPLAY]
(DS (WINDOWPROP SELWINDOW (QUOTE DSP)))
SELRES)
(RESETLST (RESETSAVE (DSPXOFFSET (IDIFFERENCE (IPLUS TXB (DSPXOFFSET NIL DS))
(fetch XKERN of OBJBOX))
DS)
(LIST (FUNCTION DSPXOFFSET)
(DSPXOFFSET NIL DS)
DS))
(RESETSAVE (DSPYOFFSET (IDIFFERENCE (IPLUS (fetch YBASE of LINE)
(DSPYOFFSET NIL DS))
(fetch YDESC of OBJBOX))
DS)
(LIST (FUNCTION DSPYOFFSET)
(DSPYOFFSET NIL DS)
DS))
(RESETSAVE (DSPCLIPPINGREGION (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(IMIN (fetch XSIZE
of OBJBOX)
(IDIFFERENCE
(fetch WRIGHT
of TEXTOBJ)
TXB))
HEIGHT ←(fetch YSIZE of OBJBOX))
DS)
(LIST (FUNCTION DSPCLIPPINGREGION)
(DSPCLIPPINGREGION NIL DS)
DS))
[SETQ SELRES (ERSETQ (APPLY* (IMAGEOBJPROP PREVCH (QUOTE BUTTONEVENTINFN))
PREVCH DS SEL (IDIFFERENCE X TXB)
(IDIFFERENCE Y (fetch YBASE of LINE))
SELWINDOW
(fetch STREAMHINT of TEXTOBJ)
(COND
(WORDSELFLG (QUOTE MIDDLE))
(T (QUOTE LEFT]
(* Go tell him he's being pointed at.)
)
(COND
((NULL SELRES) (* If the event fn returns NIL, do nothing untoward)
)
((NULL (CAR SELRES)) (* If it returns something with a CAR of NIL, then
UN-SET the object-ness of the selection)
(replace SELOBJ of SEL with NIL))
(T (* Otherwise, check to see what he wants us to do)
(COND
((EQ (CAR SELRES)
(QUOTE DON'T)) (* The object declines to be selected.
Don't permit the select to happen.)
(replace SET of SEL with NIL))
((AND (LISTP (CAR SELRES))
(FMEMB (QUOTE DON'T)
(CAR SELRES))) (* The object declines to be selected.
Don't permit the select to happen.)
(replace SET of SEL with NIL)))
(COND
((EQ (CAR SELRES)
(QUOTE CHANGED)) (* If the object claims to have changed, update the
screen.)
(TEDIT.OBJECT.CHANGED TEXTOBJ (fetch SELOBJ of SEL)))
((AND (LISTP (CAR SELRES))
(FMEMB (QUOTE CHANGED)
(CAR SELRES))) (* If the object claims to have changed, update the
screen.)
(TEDIT.OBJECT.CHANGED TEXTOBJ (fetch SELOBJ of SEL]
(SETQ WORDSELFLG NIL])
)
(DEFINEQ
(\FIXSEL
[LAMBDA (SEL TEXTOBJ THISWINDOW AVOIDINGTHISW) (* jds "31-Jul-85 20:14")
(* Given that the selection SEL contains the correct
CH# and CHLIM, reset the Y0 X0, DX, and XLIM values.)
(PROG* ((CH# (fetch CH# of SEL))
(CHLIM (fetch CHLIM of SEL))
(THISLINE (fetch THISLINE of TEXTOBJ))
(WINDOW (fetch \WINDOW of TEXTOBJ))
(THISW (OR THISWINDOW (\TEDIT.MAINW TEXTOBJ)))
(WREG (AND THISW (DSPCLIPPINGREGION NIL THISW)))
(STARTFOUND NIL)
(ENDFOUND NIL)
WLIST CHLIST LOOKS LINE PREVLINE L1HCPY LNHCPY)
(COND
((NOT THISW) (* There is no window to go with this edit;
don't bother to try updating the selection)
(RETURN)))
[COND
((AND AVOIDINGTHISW (fetch Y0 of SEL)))
(T (replace Y0 of SEL with (fetch PTOP of WREG]
(COND
((AND AVOIDINGTHISW (fetch YLIM of SEL)))
(T (replace YLIM of SEL with -1)))
(OR (fetch XLIM of SEL)
(replace XLIM of SEL with -1)) (* Initialize it, if need be.)
(for WW inside WINDOW as L1 on (fetch L1 of SEL) as LN on (fetch LN of SEL) as LINES
inside (fetch LINES of TEXTOBJ)
do (COND
([AND (fetch SET of SEL)
(OR (NOT THISWINDOW)
(NEQ AVOIDINGTHISW (EQ THISWINDOW WW]
(* Only if a "real" SELECTION proceed)
(SETQ WLIST (fetch (THISLINE WIDTHS) of THISLINE))
(SETQ CHLIST (fetch (THISLINE CHARS) of THISLINE))
(SETQ LOOKS (fetch (THISLINE LOOKS) of THISLINE))
(RPLACA L1 NIL)
(RPLACA LN NIL)
(bind (LINE ←(fetch NEXTLINE of LINES))
TX DX while LINE
do (COND
[(AND (IGEQ CH# (fetch CHAR1 of LINE))
(ILEQ CH# (fetch CHARLIM of LINE)))
(* The selection starts in this line.
Fix L1, X0, and Y0.)
(SETQ STARTFOUND T)
(replace Y0 of SEL with (fetch YBOT of LINE))
(SETQ L1HCPY (fetch FMTHARDCOPY of (fetch LFMTSPEC of LINE)))
(* Remember that this is a hardcopy-mode line)
(RPLACA L1 LINE)
(SETQ TX (fetch LEFTMARGIN of LINE))
(* Temp. X value for scanning the line from left margin
to the right)
(replace X0 of SEL with (fetch LEFTMARGIN of LINE))
(COND
((IGREATERP CH# (fetch CHAR1 of LINE))
(* Only bother formatting the line if the selection
doesn't include the first character.)
(COND
((NEQ (fetch DESC of THISLINE)
LINE) (* If this line isn't cached in THISLINE, reformat it.)
(\FORMATLINE TEXTOBJ NIL (fetch CHAR1 of LINE)
LINE)))
(COND
((IGEQ (fetch LEN of THISLINE)
0) (* As long as there's something there on the line...)
(bind (LOOKNO ← 0) for I from 0 to (fetch LEN of THISLINE)
as CHNO from (fetch CHAR1 of LINE)
do
(* Run thru the characters on the line, looking for the first selected one. Keep track of our X position, so we know
where the selection starts.)
(SETQ DX (\WORDELT WLIST I))
(SETQ TX (IPLUS TX DX))
(COND
((IGEQ CHNO CH#)
(* We've found that first character.
Time to bail out.)
(RETURN))
[(EQ LMInvisibleRun (\EDITELT CHLIST I))
(* This is INVISIBLE text. Count the characters as
though they were there.)
(add LOOKNO 1)
(add CHNO (SUB1 (\EDITELT LOOKS LOOKNO]
((EQ LMLooksChange (\EDITELT CHLIST I))
(* This is a format effector--reduce CHNO to ignore it)
(add LOOKNO 1)
(SETQ CHNO (SUB1 CHNO)))
(T (* Not yet; update our running X-position in the SEL.)
(replace X0 of SEL with TX]
((AND (IEQP CH# (ADD1 (fetch CHARLIM of LINE)))
(IGREATERP CH# (fetch TEXTLEN of TEXTOBJ)))
(* The selection starts after the end of this line, but
it's also the end of the text.
Go ahead and select there.)
(COND
((NEQ (fetch DESC of THISLINE)
LINE) (* If this line isn't cached in THISLINE, reformat it.)
(\FORMATLINE TEXTOBJ NIL (fetch CHAR1 of LINE)
LINE)))
(replace Y0 of SEL with (fetch YBOT of LINE))
(RPLACA L1 LINE) (* Make this line be the first in the selection)
(SETQ L1HCPY (fetch FMTHARDCOPY of (fetch LFMTSPEC of LINE)))
(replace X0 of SEL with (fetch LXLIM of LINE)))
((AND (NOT STARTFOUND)
(IGREATERP (fetch CHAR1 of LINE)
CH#)
(ILESSP (fetch CHAR1 of LINE)
CHLIM)) (* The selection starts before this line, so play
catch-up)
(replace Y0 of SEL with (fetch YBOT of LINE))
(RPLACA L1 LINE) (* Grab this line and make it the apparent first line.)
(SETQ L1HCPY (fetch FMTHARDCOPY of (fetch LFMTSPEC of LINE)))
(replace X0 of SEL with (fetch LEFTMARGIN of LINE))
(SETQ STARTFOUND T)))
[COND
([AND (ILEQ CH# (fetch CHARLIM of LINE))
(IGEQ CHLIM (fetch CHAR1 of LINE))
(ILEQ CHLIM (ADD1 (fetch CHARLIM of LINE]
(* The selection ends in this line.
Fix LN, XLIM, and YLIM.)
(* NB that it also has to START before the end of this line. This eliminates the case of a 0-wide selection right
after the last char on this line.)
(replace YLIM of SEL with (fetch YBOT of LINE))
(* Set the lowest-Y value for the selection)
(RPLACA LN LINE) (* Remember the final line)
(SETQ LNHCPY (fetch FMTHARDCOPY of (fetch LFMTSPEC of LINE)))
(SETQ TX (fetch LEFTMARGIN of LINE))
(* Temp X position)
(replace XLIM of SEL with (fetch LXLIM of LINE))
(* Start by assuming that the selection extends all the
way across the line)
[COND
[(AND (IEQP CHLIM (ADD1 (fetch CHARLIM of LINE)))
(EQ (fetch POINT of SEL)
(QUOTE RIGHT))
(IEQP (fetch DCH of SEL)
0)
(fetch NEXTLINE of LINE)
(fetch CR\END of LINE))
(* This selection starts AFTER the CR on a line, and
doesn't include it.)
(RPLACA LN (fetch NEXTLINE of LINE))
(* Change the selection to start on the next line, at
the margin, instead.)
(replace XLIM of SEL with (fetch LEFTMARGIN of (CAR LN)))
(replace YLIM of SEL with (fetch YBOT of (CAR LN]
((ILEQ CHLIM (IMIN (fetch CHARLIM of LINE)
(fetch TEXTLEN of TEXTOBJ)))
(* Only bother formatting if the selection doesn't
include the last char on the line)
(COND
((NEQ (fetch DESC of THISLINE)
LINE) (* If this line isn't cached in THISLINE, then reformat
it.)
(\FORMATLINE TEXTOBJ NIL (fetch CHAR1 of LINE)
LINE)))
(COND
((IGEQ (fetch LEN of THISLINE)
0) (* If there are characters on the line, go looking for
the one that ends the selection.)
(bind (LOOKNO ← 0) for I from 0 to (fetch LEN of THISLINE)
as CHNO from (fetch CHAR1 of LINE)
do
(* Run thru the characters, until we find the final one that is selected. Kep running track of our X position on the
line, so we know how wide the final line's hiliting should be.)
(SETQ DX (\WORDELT WLIST I))
(* The current character's width)
(SETQ TX (IPLUS TX DX))
(* Running Temp-X position)
(COND
((IGEQ CHNO CHLIM)
(* OK; this character is past the end of the selection.
Stop here.)
(RETURN))
[(EQ LMInvisibleRun (\EDITELT CHLIST I))
(* This is a run of INVISIBLE characters.
Count them in the character position, though.)
(add LOOKNO 1)
(add CHNO (SUB1 (\EDITELT LOOKS LOOKNO]
((EQ LMLooksChange (\EDITELT CHLIST I))
(* This is a format effector--reduce CHNO to ignore it)
(SETQ CHNO (SUB1 CHNO))
(add LOOKNO 1))
(T (* Keep track of how far across we've gotten.)
(replace XLIM of SEL with TX]
(RETURN) (* And stop looking for an ending line--we've obviously
found it!)
)
((AND (IEQP CHLIM (ADD1 (fetch CHARLIM of LINE)))
(ILEQ CH# (fetch CHARLIM of LINE)))
(* The selection ends either here or at the start of
the next line.)
(* ANN there is something on this line really
selected.)
(replace YLIM of SEL with (fetch YBOT of LINE))
(SETQ LNHCPY (fetch FMTHARDCOPY of (fetch LFMTSPEC of LINE)))
(RPLACA LN LINE)
(replace XLIM of SEL with (fetch LXLIM of LINE]
(SETQ PREVLINE LINE)
(SETQ LINE (fetch NEXTLINE of LINE)))
[COND
(L1HCPY (* The first line of the selection is hardcopy-mode.
Convert the X0 value to screen units)
(replace X0 of SEL with (FIXR (FQUOTIENT (fetch X0 of SEL)
35.27778]
[COND
(LNHCPY (* The last line of the selection is hardcopy-mode.
Convert the XLIM value to screen units)
(replace XLIM of SEL with (FIXR (FQUOTIENT (fetch XLIM of SEL)
35.27778]
(COND
[(IEQP 0 (fetch DCH of SEL)) (* If this is a point selection, put it on the correct
side of the character we selected.)
(replace (SELECTION DX) of SEL with 0)
(COND
((EQ (fetch POINT of SEL)
(QUOTE LEFT))
(replace XLIM of SEL with (fetch X0 of SEL)))
(T (replace X0 of SEL with (fetch XLIM of SEL]
(T (* Otherwise, fix DX for the selection)
(replace (SELECTION DX) of SEL with (IDIFFERENCE (fetch XLIM of SEL)
(fetch X0 of SEL])
(\TEDIT.FIXDELSEL
[LAMBDA (SELTOFIX TEXTOBJ CH#1 CH#LIM DCH) (* jds " 6-Mar-85 22:18")
(* Fix up a SELTOFIX after deletion inside that
textobj)
(* Only if the Selection is set, and is in THIS
textobj)
(COND
((AND (fetch SET of SELTOFIX)
(EQ TEXTOBJ (fetch \TEXTOBJ of SELTOFIX)))
(COND
((IGEQ (fetch CH# of SELTOFIX)
CH#LIM) (* The selection is after the deleted text.
Just move it forward)
(replace CH# of SELTOFIX with (IDIFFERENCE (fetch CH# of SELTOFIX)
DCH))
(replace CHLIM of SELTOFIX with (IDIFFERENCE (fetch CHLIM of SELTOFIX)
DCH)))
((IGREATERP (fetch CHLIM of SELTOFIX)
CH#1) (* It overlaps, at least partially.)
(COND
((IGEQ (fetch CH# of SELTOFIX)
CH#1) (* If the start of the selection was inside the deleted
area, it now starts where the deletion left off.)
(replace CH# of SELTOFIX with CH#1)))
(replace CHLIM of SELTOFIX with (IMAX CH#1 (IDIFFERENCE (fetch CHLIM of SELTOFIX)
DCH)))
(replace DCH of SELTOFIX with (COND
((IEQP (fetch CHLIM of SELTOFIX)
CH#1)
0)
(T (IDIFFERENCE (fetch CHLIM of SELTOFIX)
(fetch CH# of SELTOFIX])
(\TEDIT.FIXINSSEL
[LAMBDA (SELTOFIX TEXTOBJ CH#1 DCH) (* jds " 6-Mar-85 22:18")
(* Fix up a SELTOFIX after deletion inside that
textobj)
(* Only if the Selection is set, and is in THIS
textobj)
(PROG (CH# CHLIM)
(COND
((AND (fetch SET of SELTOFIX)
(EQ TEXTOBJ (fetch \TEXTOBJ of SELTOFIX)))
[COND
((IGEQ (SETQ CH# (ffetch CH# of SELTOFIX))
CH#1) (* Fix up the selection; if we're beyond the insert
point, move the whole sel forward)
(freplace CH# of SELTOFIX with (IPLUS CH# DCH]
(COND
((IGREATERP (SETQ CHLIM (ffetch CHLIM of SELTOFIX))
CH#1) (* And the tail end of the sel, too.)
(freplace CHLIM of SELTOFIX with (IPLUS CHLIM DCH])
(\TEDIT.FIXSELS
[LAMBDA (TEXTOBJ EXCEPT) (* jds " 3-AUG-83 13:05")
(* Fixes all the sels for a given textobj.)
(for SELN in (LIST (fetch SEL of TEXTOBJ)
(fetch SHIFTEDSEL of TEXTOBJ)
(fetch MOVESEL of TEXTOBJ)
(fetch DELETESEL of TEXTOBJ))
when (NEQ SELN EXCEPT) do (AND (fetch SET of SELN)
(\FIXSEL SELN TEXTOBJ])
)
(DEFINEQ
(TEDIT.RESET.EXTEND.PENDING.DELETE
[LAMBDA (SEL) (* jds "13-Dec-84 11:01")
(* Reset the "Extend Pending Delete" status)
(AND SEL (\TEDIT.SET.SEL.LOOKS SEL (QUOTE NORMAL)))
(SETQ TEDIT.PENDINGDEL NIL)
(AND (fetch \TEXTOBJ of SEL)
(replace BLUEPENDINGDELETE of (fetch \TEXTOBJ of SEL) with NIL])
(\TEDIT.SET.SEL.LOOKS
[LAMBDA (SEL OPERATION) (* jds "13-Dec-84 10:55")
(* Set what the selection should be displayed like,
given what it's for (NORMAL, COPY, MOVE, etc.))
(SELECTQ OPERATION
(NORMAL (* Regular selection)
(replace HOW of SEL with BLACKSHADE)
(replace HOWHEIGHT of SEL with 1)
(replace HASCARET of SEL with T))
(COPY (* Copy source)
(replace HOW of SEL with COPYSELSHADE)
(replace HOWHEIGHT of SEL with 1)
(replace HASCARET of SEL with NIL))
(COPYLOOKS (* copylooks source)
(replace HOW of SEL with COPYLOOKSSELSHADE)
(replace HOWHEIGHT of SEL with 2)
(replace HASCARET of SEL with NIL))
(MOVE (* Copy source)
(replace HOW of SEL with EDITMOVESHADE)
(replace HOWHEIGHT of SEL with 16384)
(replace HASCARET of SEL with NIL))
(DELETE (* To be deleted instantly)
(replace HOW of SEL with BLACKSHADE)
(replace HOWHEIGHT of SEL with 16384)
(replace HASCARET of SEL with NIL)
NIL)
(PENDINGDEL (* Delete at next type-in)
(replace HOW of SEL with BLACKSHADE)
(replace HOWHEIGHT of SEL with 16384)
(replace HASCARET of SEL with T)
NIL)
(INVERTED (* For people who really want to see what's selected.)
(replace HOW of SEL with BLACKSHADE)
(replace HOWHEIGHT of SEL with 16384)
(replace HASCARET of SEL with T)
NIL)
NIL])
)
(DEFINEQ
(\SHOWSEL
[LAMBDA (SEL HOW ON) (* jds "15-Oct-85 17:19")
(* Highlight the selection SEL, according to HOW,
turning it on or off according to ON)
(COND
((AND SEL (fetch SET of SEL)
(fetch \WINDOW of (fetch \TEXTOBJ of SEL)))
(* This operation only makes sense if there is a
selection, it has been set, and there's a window to do
the highlighting in.)
(PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(SHADE (OR (fetch HOW of SEL)
BLACKSHADE))
(SHADEHEIGHT (OR (fetch HOWHEIGHT of SEL)
1))
LL SHOWFN)
[for DS inside (fetch \WINDOW of TEXTOBJ) as LINES
inside (fetch LINES of TEXTOBJ) as L1 in (fetch L1 of SEL)
as LN in (fetch LN of SEL) as CARET inside (fetch CARET
of TEXTOBJ)
do (COND
((fetch SELOBJ of SEL) (* If it is an object and it has a non-nil showselfn
then use it)
(\TEDIT.OBJECT.SHOWSEL TEXTOBJ SEL ON DS)
(RETURN)))
(COND
[(AND ON (NOT (fetch ONFLG of SEL)))
(* It's off and we want to turn it on)
(\SHOWSEL.HILIGHT TEXTOBJ SEL LINES L1 LN DS SHADEHEIGHT SHADE)
(COND
((fetch HASCARET of SEL) (* If the selection has a caret, turn one on.)
(COND
[(EQ (fetch POINT of SEL)
(QUOTE LEFT)) (* At the LEFT end of the selection)
(COND
((AND L1 (IGEQ (fetch YBOT of L1)
0))
(\SETCARET (fetch X0 of SEL)
(fetch YBASE of L1)
DS TEXTOBJ CARET))
(T (MOVETO -10 -10 DS]
((AND LN (IGEQ (fetch YBOT of LN)
0)) (* Or at the RIGHT end.)
(\SETCARET (fetch XLIM of SEL)
(fetch YBASE of LN)
DS TEXTOBJ CARET))
(T (* Neither end is on screen.
For self-caret flashers, move the caret location
off-screen)
(MOVETO -10 -10 DS]
((AND (NOT ON)
(fetch ONFLG of SEL))
(* The selection is highlighted and we want to turn it
off.)
(COND
((AND (fetch HASCARET of SEL)
(NOT (fetch TXTREADONLY of TEXTOBJ)))
(* IF the selection has a caret with it, make sure
it's turned off.)
(\EDIT.UPCARET CARET) (* Pick the caret up off the screen.)
))
(\SHOWSEL.HILIGHT TEXTOBJ SEL LINES L1 LN DS SHADEHEIGHT SHADE]
(replace ONFLG of SEL with ON])
(\SHOWSEL.HILIGHT
[LAMBDA (TEXTOBJ SEL LINES L1 LN DS SHADEHEIGHT SHADE X0 XLIM)
(* jds "15-Oct-85 17:19")
(* * Do the actual highlighting and unhighlighting of a selection for \SHOWSEL)
(PROG (LL LEFT RIGHT)
(COND
((OR L1 LN) (* One end or the other is on-screen, so it makes
sense to try displaying something.)
(COND
((AND L1 (EQ L1 LN)
(IGEQ (fetch YBOT of L1)
0)) (* It's all in a single line;
just underline the right section and beat it)
(BITBLT NIL 0 0 DS (OR X0 (fetch X0 of SEL))
(fetch YBOT of L1)
(IDIFFERENCE (OR XLIM (fetch XLIM of SEL))
(OR X0 (fetch X0 of SEL)))
(IMIN SHADEHEIGHT (fetch LHEIGHT of L1))
(QUOTE TEXTURE)
(QUOTE INVERT)
SHADE))
(T (* Different lines.)
(COND
((AND L1 (IGEQ (fetch YBOT of L1)
0)) (* If the first line is known, underline the right
section of it.)
[SETQ RIGHT (COND
((fetch FMTHARDCOPY of (fetch LFMTSPEC of L1))
(FIXR (FQUOTIENT (fetch LXLIM of L1)
35.27778)))
(T (fetch LXLIM of L1]
(BITBLT NIL 0 0 DS (OR X0 (fetch X0 of SEL))
(fetch YBOT of L1)
(IDIFFERENCE RIGHT (OR X0 (fetch X0 of SEL)))
(IMIN SHADEHEIGHT (fetch LHEIGHT of L1))
(QUOTE TEXTURE)
(QUOTE INVERT)
SHADE)))
(SETQ LL (OR L1 LINES))
(AND LL (SETQ LL (fetch NEXTLINE of LL)))
(* The line after the first, or the top line on the
screen -- if we didn't have a first line)
(while LL until (OR (EQ LL LN)
(ILESSP (fetch YBOT of LL)
(fetch WBOTTOM of TEXTOBJ)))
do (* Highlight every line between first and last)
[COND
[(fetch FMTHARDCOPY of (fetch LFMTSPEC of LL))
(* This line is in hardcopy mode.
Scale the margin values)
(SETQ LEFT (\MICASTOPTS (fetch LEFTMARGIN of LL)))
(SETQ RIGHT (\MICASTOPTS (fetch LXLIM of LL]
(T (SETQ LEFT (fetch LEFTMARGIN of LL))
(SETQ RIGHT (fetch LXLIM of LL]
(BITBLT NIL 0 0 DS LEFT (fetch YBOT of LL)
(IDIFFERENCE RIGHT LEFT)
(IMIN SHADEHEIGHT (fetch LHEIGHT of LL))
(QUOTE TEXTURE)
(QUOTE INVERT)
SHADE)
(SETQ LL (fetch NEXTLINE of LL)))
(COND
((AND LL (IGEQ (fetch YBOT of LL)
(fetch WBOTTOM of TEXTOBJ)))
(* The final line is on-screen.
Hilight it, too.)
[SETQ LEFT (COND
((fetch FMTHARDCOPY of (fetch LFMTSPEC of LL))
(\MICASTOPTS (fetch LEFTMARGIN of LL)))
(T (fetch LEFTMARGIN of LL]
(BITBLT NIL 0 0 DS LEFT (fetch YBOT of LN)
(IDIFFERENCE (OR XLIM (fetch XLIM of SEL))
LEFT)
(IMIN SHADEHEIGHT (fetch LHEIGHT of LL))
(QUOTE TEXTURE)
(QUOTE INVERT)
SHADE))) (* Highlight the final line of the selection)
])
(\TEDIT.UPDATE.SHOWSEL
[LAMBDA (NSEL OSEL TSTFLG) (* jds "31-Jul-85 21:03")
(* Update the selection highlighting to reflect the
differences between NSEL and OSEL)
(PROG ((TEXTOBJ (fetch \TEXTOBJ of OSEL)))
(PROG ((SHADE (OR (fetch HOW of OSEL)
BLACKSHADE))
(SHADEHEIGHT (OR (fetch HOWHEIGHT of OSEL)
1))
(EXCHFLG NIL)
TSEL LL)
(replace ONFLG of NSEL with T) (* Make the new selection think that we've really
displayed all its new aspects.)
[COND
((fetch HASCARET of OSEL) (* Turn off the caret, if need be)
(for CARET inside (fetch CARET of TEXTOBJ) do (\EDIT.UPCARET CARET]
[COND
((NEQ (fetch CH# of NSEL)
(fetch CH# of OSEL)) (* The new selection starts earlier;
add hilight at the front)
(COND
((ILESSP (fetch CH# of OSEL)
(fetch CH# of NSEL)) (* Actually, it starts later;
just exchange the selections)
(swap OSEL NSEL)
(SETQ EXCHFLG T)))
(for NEWL1 inside (fetch L1 of NSEL) as OLDL1 inside (fetch L1 of OSEL)
as LINES inside (fetch LINES of TEXTOBJ) as DS inside (fetch \WINDOW
of TEXTOBJ)
do (\SHOWSEL.HILIGHT TEXTOBJ OSEL LINES NEWL1 OLDL1 DS SHADEHEIGHT SHADE
(fetch X0 of NSEL)
(fetch X0 of OSEL]
(COND
(EXCHFLG (* Put the selections back as they were.)
(swap OSEL NSEL)
(SETQ EXCHFLG NIL)))
(COND
((ILESSP (fetch CHLIM of NSEL)
(fetch CHLIM of OSEL)) (* Arrange for NSEL to be the selection that ends
later, so that one set of code will do both earlier AND
later cases.)
(swap OSEL NSEL)
(SETQ EXCHFLG T)))
(for OLDLN in (fetch LN of OSEL) as NEWLN in (fetch LN of NSEL) as LINES
inside (fetch LINES of TEXTOBJ) as OLDL1 in (fetch L1 of OSEL) as DS
inside (fetch \WINDOW of TEXTOBJ)
do (\SHOWSEL.HILIGHT TEXTOBJ OSEL LINES OLDLN NEWLN DS SHADEHEIGHT SHADE
(fetch XLIM of OSEL)
(fetch XLIM of NSEL)))
(COND
(EXCHFLG (* Put the selections back as they were.)
(SETQ TSEL OSEL)
(SETQ OSEL NSEL)
(SETQ NSEL TSEL)))
(COND
((fetch HASCARET of NSEL) (* Now put the caret back up.)
(for L1 in (fetch L1 of NSEL) as LN in (fetch LN of NSEL) as DS
inside (fetch \WINDOW of TEXTOBJ) as CARET inside (fetch CARET of TEXTOBJ)
do (COND
((EQ (fetch POINT of NSEL)
(QUOTE LEFT)) (* Left end of the selection)
(AND L1 (\SETCARET (fetch X0 of NSEL)
(fetch YBOT of L1)
DS TEXTOBJ CARET)))
(LN (* Right end of the selection)
(\SETCARET (fetch XLIM of NSEL)
(fetch YBOT of LN)
DS TEXTOBJ CARET])
(\TEDIT.SHOWSELS
[LAMBDA (TEXTOBJ HOW ON) (* jds "22-MAR-83 14:47")
(* Turns all the selections for a given Textobj on or
off)
(for SELN in (LIST (fetch SEL of TEXTOBJ)
(fetch SHIFTEDSEL of TEXTOBJ)
(fetch MOVESEL of TEXTOBJ)
(fetch DELETESEL of TEXTOBJ))
do (AND (fetch SET of SELN)
(\SHOWSEL SELN HOW ON])
(\TEDIT.REFRESH.SHOWSEL
[LAMBDA (TEXTOBJ NEWSEL OLDSEL OLDOP NEWOP EXTENDING) (* jds "30-Sep-85 11:24")
(* * Update the screen hilighting to account for the changes that have taken place between OLDSEL and NEWSEL.)
(DECLARE (USEDFREE . GLOBALSEL))
(PROG (NOSEL)
(COND
((AND EXTENDING (EQ OLDOP NEWOP)) (* If we're extending a selection and the looks haven't
changed, we can do it the fast way, to prevent
flicker.)
(\TEDIT.UPDATE.SHOWSEL NEWSEL OLDSEL)
(\COPYSEL NEWSEL OLDSEL)
(replace ONFLG of OLDSEL with T))
(T (* Otherwise, we have to turn the old one off, change
things, and turn the new one on.)
(\SHOWSEL OLDSEL NIL NIL)
(COND
((NEQ OLDOP NEWOP) (* He changed his mind about copying, deleting, or
whatever -- change the kind of selection it is.)
(SELECTQ NEWOP
((NORMAL PENDINGDEL)
(SETQ GLOBALSEL TEDIT.SELECTION)
(SETQ NOSEL (fetch SEL of TEXTOBJ)))
(COPY (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
(SETQ NOSEL (fetch SHIFTEDSEL of TEXTOBJ)))
(MOVE (SETQ GLOBALSEL TEDIT.MOVESELECTION)
(SETQ NOSEL (fetch MOVESEL of TEXTOBJ)))
(DELETE (SETQ GLOBALSEL TEDIT.DELETESELECTION)
(SETQ NOSEL (fetch DELETESEL of TEXTOBJ)))
(COPYLOOKS (SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION)
(SETQ NOSEL (fetch SHIFTEDSEL of TEXTOBJ)))
NIL) (* Remember the new operation type.)
(replace SET of OLDSEL with NIL) (* Turn off the old kind of selection, so it doesn't
reappear to haunt us.)
(AND (fetch SET of NOSEL)
(\SHOWSEL NOSEL NIL NIL)) (* If there was a new-type selection around, turn it
off.)
(SETQ OLDSEL NOSEL) (* Now cut over to the new selection)
(\TEDIT.SET.SEL.LOOKS OLDSEL NEWOP) (* And set it up looking right.)
))
(\COPYSEL NEWSEL OLDSEL)
(replace ONFLG of OLDSEL with NIL) (* Make sure we can turn the highlighting on.)
(\SHOWSEL OLDSEL NIL T)))
(RETURN (OR NOSEL OLDSEL])
)
(DEFINEQ
(\COPYSEL
[LAMBDA (FROM TO) (* jds "21-Jan-85 18:39")
(* Copy a SELECTION record from FROM to TO, without
creating any new ones)
(replace Y0 of TO with (fetch Y0 of FROM))
(replace X0 of TO with (fetch X0 of FROM))
(replace (SELECTION DX) of TO with (fetch (SELECTION DX) of FROM))
(replace CH# of TO with (fetch CH# of FROM))
(replace XLIM of TO with (fetch XLIM of FROM))
(replace CHLIM of TO with (fetch CHLIM of FROM))
(replace DCH of TO with (fetch DCH of FROM))
(replace L1 of TO with (COPY (fetch L1 of FROM)))
(replace LN of TO with (COPY (fetch LN of FROM)))
(replace YLIM of TO with (fetch YLIM of FROM))
(replace POINT of TO with (fetch POINT of FROM))
(replace SET of TO with (fetch SET of FROM))
(replace \TEXTOBJ of TO with (fetch \TEXTOBJ of FROM))
(replace SELKIND of TO with (fetch SELKIND of FROM))
(replace HOW of TO with (fetch HOW of FROM))
(replace HOWHEIGHT of TO with (fetch HOWHEIGHT of FROM))
(replace HASCARET of TO with (fetch HASCARET of FROM))
(replace SELOBJ of TO with (fetch SELOBJ of FROM))
(replace ONFLG of TO with (fetch ONFLG of FROM])
(\TEDIT.SEL.CHANGED?
[LAMBDA (NEWSEL OLDSEL OLDSELOP NEWSELOP) (* jds "18-Aug-84 13:23")
(* Decide whether there has been an interesting change
in the selection, so we can decide whether to refresh
its hilighting on the screen.)
(AND NEWSEL (fetch SET of NEWSEL)
(NOT (AND (fetch SET of OLDSEL)
(EQ (fetch SET of OLDSEL)
(fetch SET of NEWSEL))
(EQUAL (fetch CH# of NEWSEL)
(fetch CH# of OLDSEL))
(EQUAL (fetch CHLIM of NEWSEL)
(fetch CHLIM of OLDSEL))
(EQ (fetch \TEXTOBJ of NEWSEL)
(fetch \TEXTOBJ of OLDSEL))
(IEQP (fetch (SELECTION DX) of NEWSEL)
(fetch (SELECTION DX) of OLDSEL))
(EQ (fetch POINT of NEWSEL)
(fetch POINT of OLDSEL))
(EQ (fetch HOW of NEWSEL)
(fetch HOW of OLDSEL))
(EQ (fetch HOWHEIGHT of NEWSEL)
(fetch HOWHEIGHT of OLDSEL))
(EQ OLDSELOP NEWSELOP])
)
(* * User entries to the selection code)
(DEFINEQ
(TEDIT.GETPOINT
[LAMBDA (STREAM SEL) (* jds " 6-Mar-85 22:07")
(* Given a selection, tell the CH# that type-in would be inserted in front of. IF SEL is given, use it to decide.
Otherwise, use STREAM's current selection.)
(PROG [(TSEL (OR SEL (fetch SEL of (TEXTOBJ STREAM]
(RETURN (IMAX 1 (SELECTQ (fetch POINT of TSEL)
(LEFT (fetch CH# of TSEL))
(RIGHT (fetch CHLIM of TSEL))
(SHOULDNT "Selection's POINT is neither RIGHT nor LEFT."])
(TEDIT.GETSEL
[LAMBDA (STREAM) (* jds "21-Dec-84 16:08")
(create SELECTION using (fetch SEL of (fetch (TEXTSTREAM TEXTOBJ) of STREAM])
(TEDIT.MAKESEL
[LAMBDA (STREAM CH# LEN POINT) (* jds " 6-Mar-85 21:18")
(PROG ((SEL (fetch SEL of (fetch (TEXTSTREAM TEXTOBJ) of STREAM)))
(TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)))
(\SHOWSEL SEL NIL NIL)
(replace CH# of SEL with CH#)
(replace CHLIM of SEL with (IMAX CH# (IPLUS CH# LEN)))
(replace DCH of SEL with LEN)
(replace POINT of SEL with (OR POINT (QUOTE LEFT)))
(replace \TEXTOBJ of SEL with TEXTOBJ)
(replace SET of SEL with T)
(AND (fetch \WINDOW of TEXTOBJ)
(\FIXSEL SEL TEXTOBJ))
(\SHOWSEL SEL NIL T])
(TEDIT.SCANSEL
[LAMBDA (STREAM) (* jds "14-Feb-84 16:29")
(* Set up to read the selected text;
return the sel's length or NIL if nothing selected.)
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
SEL)
(SETQ SEL (fetch SEL of TEXTOBJ))
(COND
((fetch SET of SEL)
(\SETUPGETCH (fetch CH# of SEL)
TEXTOBJ)
(RETURN (fetch DCH of SEL)))
(T (RETURN NIL])
(TEDIT.SET.SEL.LOOKS
[LAMBDA (SEL OPERATION) (* jds "13-Dec-84 11:04")
(* Set what the selection should be displayed like,
given what it's for (NORMAL, COPY, MOVE, etc.))
(PROG ((WASON (fetch ONFLG of SEL)))
(\SHOWSEL SEL NIL NIL)
(SELECTQ OPERATION
(NORMAL (* Regular selection)
(replace HOW of SEL with BLACKSHADE)
(replace HOWHEIGHT of SEL with 1)
(replace HASCARET of SEL with T))
(COPY (* Copy source)
(replace HOW of SEL with COPYSELSHADE)
(replace HOWHEIGHT of SEL with 1)
(replace HASCARET of SEL with NIL))
(COPYLOOKS (* copylooks source)
(replace HOW of SEL with COPYLOOKSSELSHADE)
(replace HOWHEIGHT of SEL with 2)
(replace HASCARET of SEL with NIL))
(MOVE (* Copy source)
(replace HOW of SEL with EDITMOVESHADE)
(replace HOWHEIGHT of SEL with 16384)
(replace HASCARET of SEL with NIL))
(DELETE (* To be deleted instantly)
(replace HOW of SEL with BLACKSHADE)
(replace HOWHEIGHT of SEL with 16384)
(replace HASCARET of SEL with NIL)
NIL)
(PENDINGDEL (* Delete at next type-in)
(replace HOW of SEL with BLACKSHADE)
(replace HOWHEIGHT of SEL with 16384)
(replace HASCARET of SEL with T)
NIL)
(INVERTED (* For people who really want to see what's selected.)
(replace HOW of SEL with BLACKSHADE)
(replace HOWHEIGHT of SEL with 16384)
(replace HASCARET of SEL with T)
NIL)
NIL)
(\SHOWSEL SEL NIL WASON])
(TEDIT.SETSEL
[LAMBDA (STREAM CH# LEN POINT PENDINGDELFLG LEAVECARETLOOKS OPERATION)
(* jds " 6-Mar-85 22:21")
(* Given a text stream or textobj, and a piece of text
to select, set the internal selection, and return it.)
(* Make sure we got a stream)
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
SEL TEXTLEN)
(SETQ SEL (fetch SEL of TEXTOBJ))
(SETQ TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(\SHOWSEL SEL NIL NIL) (* First turn the old sel off.)
[COND
((type? SELECTION CH#) (* He gave use a selection; just plug it in)
(\COPYSEL CH# SEL)
(replace ONFLG of SEL with NIL) (* And make sure it can be turned on.)
)
(T (* He fed us numbers; use them)
(replace CH# of SEL with (IMIN (IMAX 1 CH#)
(ADD1 TEXTLEN)))
(* Starting character)
[replace CHLIM of SEL with (IMAX 1 CH# (IMIN (IPLUS CH# LEN)
(ADD1 TEXTLEN]
(* Last selected character)
[replace DCH of SEL with (IMIN LEN TEXTLEN (IDIFFERENCE (fetch CHLIM of SEL)
(fetch CH# of SEL]
(replace POINT of SEL with (OR (AND (IGREATERP CH# TEXTLEN)
(QUOTE LEFT))
POINT
(QUOTE LEFT)))
(* Which side the caret should go on)
(COND
((OR (IGREATERP (fetch CH# of SEL)
TEXTLEN)
(NEQ 1 LEN))
(replace SELOBJ of SEL with NIL))
(T (replace SELOBJ of SEL with (fetch POBJ of (\CHTOPC (fetch CH# of SEL)
(fetch PCTB of TEXTOBJ]
(replace \TEXTOBJ of SEL with TEXTOBJ) (* Link it back to the associated textobj)
[COND
(PENDINGDELFLG (* This selection is to be a pending-deletion sel.)
(replace BLUEPENDINGDELETE of TEXTOBJ with T)
(* Warn TEdit that there's a deletion pending)
(\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION (QUOTE PENDINGDEL)))
(* And make the selection look right.)
)
(T (* This selection is to be a pending-deletion sel.)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL)
(\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION (QUOTE NORMAL]
(replace SET of SEL with T) (* Mark the selection as valid for others to use)
[COND
((NOT LEAVECARETLOOKS) (* And set the insertion looks to follow.)
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL]
(AND (fetch \WINDOW of TEXTOBJ)
(\FIXSEL SEL TEXTOBJ)) (* Update the selection's screen location)
(\SHOWSEL SEL NIL T) (* Highlight it on the screen)
(RETURN SEL])
(TEDIT.SHOWSEL
[LAMBDA (STREAM ONFLG SEL) (* jds "14-Feb-84 16:29")
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)))
(COND
(SEL (* He's giving us a selection to highlight.
Connect it to this textobj.)
(replace \TEXTOBJ of SEL with TEXTOBJ)
(\FIXSEL SEL TEXTOBJ)))
(\SHOWSEL (OR SEL (fetch SEL of TEXTOBJ))
NIL ONFLG])
)
(PUTPROPS TEDITSELECTION COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5418 17013 (TEDIT.SEL.AS.STRING 5428 . 6766) (TEDIT.SELECTED.PIECES 6768 . 9213) (
\TEDIT.FIND.FIRST.LINE 9215 . 11831) (\TEDIT.FIND.LAST.LINE 11833 . 12873) (
\TEDIT.FIND.OVERLAPPING.LINE 12875 . 13182) (\TEDIT.FIND.PROTECTED.END 13184 . 14923) (
\TEDIT.FIND.PROTECTED.START 14925 . 16500) (\TEDIT.WORD.BOUND 16502 . 17011)) (18179 53146 (
TEDIT.EXTEND.SEL 18189 . 25819) (TEDIT.SELECT 25821 . 28717) (TEDIT.SCAN.LINE 28719 . 40475) (
TEDIT.SELECT.LINE.SCANNER 40477 . 49295) (\TEDIT.SELECT.CHARACTER 49297 . 53144)) (53147 69770 (
\FIXSEL 53157 . 66388) (\TEDIT.FIXDELSEL 66390 . 68134) (\TEDIT.FIXINSSEL 68136 . 69219) (
\TEDIT.FIXSELS 69221 . 69768)) (69771 72367 (TEDIT.RESET.EXTEND.PENDING.DELETE 69781 . 70256) (
\TEDIT.SET.SEL.LOOKS 70258 . 72365)) (72368 86276 (\SHOWSEL 72378 . 75568) (\SHOWSEL.HILIGHT 75570 .
79518) (\TEDIT.UPDATE.SHOWSEL 79520 . 83171) (\TEDIT.SHOWSELS 83173 . 83720) (\TEDIT.REFRESH.SHOWSEL
83722 . 86274)) (86277 89167 (\COPYSEL 86287 . 87965) (\TEDIT.SEL.CHANGED? 87967 . 89165)) (89215
97998 (TEDIT.GETPOINT 89225 . 89827) (TEDIT.GETSEL 89829 . 90047) (TEDIT.MAKESEL 90049 . 90867) (
TEDIT.SCANSEL 90869 . 91487) (TEDIT.SET.SEL.LOOKS 91489 . 93705) (TEDIT.SETSEL 93707 . 97466) (
TEDIT.SHOWSEL 97468 . 97996)))))
STOP