(FILECREATED " 8-Oct-86 10:58:25" {ERIS}<TEDIT>TEDITSELECTION.;19 133159
changes to: (VARS TEDITSELECTIONCOMS)
previous date: " 6-Oct-86 12:47:55" {ERIS}<TEDIT>TEDITSELECTION.;18)
(* "
Copyright (c) 1983, 1984, 1985, 1986 by John Sybalsky & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TEDITSELECTIONCOMS)
(RPAQQ TEDITSELECTIONCOMS ((FILES TEDITDECLS)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
(FILES (LOADCOMP)
TEDITDECLS))
(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)
(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))))
(FILESLOAD TEDITDECLS)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \SCRATCHLEN 64)
(CONSTANTS (\SCRATCHLEN 64))
)
(FILESLOAD (LOADCOMP)
TEDITDECLS)
)
(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])
)
(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 "21-Apr-86 14:00")
(* 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 (COND
((ILEQ (IDIFFERENCE LINE:CHAR1 L:CH#)
(IDIFFERENCE L:CHLIM LINE:CHARLIM))
(QUOTE LEFT))
(T (QUOTE RIGHT]
(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 "24-Sep-86 01:34")
(* Highlight the selection SEL,
according to HOW, turning it on or off
according to ON)
(PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(SHADE (OR (fetch HOW of SEL)
BLACKSHADE))
(SHADEHEIGHT (OR (fetch HOWHEIGHT of SEL)
1))
LL SHOWFN)
(COND
([OR (NOT (fetch SET of SEL))
(NOT (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.)
(RETURN))
((fetch TXTDON'TUPDATE of TEXTOBJ) (* ;
"We're suppressing screen updating, so don't do anything visible.")
(RETURN)))
[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 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3334 18099 (TEDIT.SEL.AS.STRING 3344 . 4965) (TEDIT.SELECTED.PIECES 4967 . 8231) (
\TEDIT.FIND.FIRST.LINE 8233 . 11728) (\TEDIT.FIND.LAST.LINE 11730 . 13066) (
\TEDIT.FIND.OVERLAPPING.LINE 13068 . 13436) (\TEDIT.FIND.PROTECTED.END 13438 . 15612) (
\TEDIT.FIND.PROTECTED.START 15614 . 17562) (\TEDIT.WORD.BOUND 17564 . 18097)) (19000 72092 (
TEDIT.EXTEND.SEL 19010 . 30475) (TEDIT.SELECT 30477 . 34173) (TEDIT.SCAN.LINE 34175 . 52011) (
TEDIT.SELECT.LINE.SCANNER 52013 . 66150) (\TEDIT.SELECT.CHARACTER 66152 . 72090)) (72093 96181 (
\FIXSEL 72103 . 91738) (\TEDIT.FIXDELSEL 91740 . 94146) (\TEDIT.FIXINSSEL 94148 . 95529) (
\TEDIT.FIXSELS 95531 . 96179)) (96182 99331 (TEDIT.RESET.EXTEND.PENDING.DELETE 96192 . 96728) (
\TEDIT.SET.SEL.LOOKS 96730 . 99329)) (99332 118875 (\SHOWSEL 99342 . 103956) (\SHOWSEL.HILIGHT 103958
. 109603) (\TEDIT.UPDATE.SHOWSEL 109605 . 114778) (\TEDIT.SHOWSELS 114780 . 115456) (
\TEDIT.REFRESH.SHOWSEL 115458 . 118873)) (118876 122197 (\COPYSEL 118886 . 120609) (
\TEDIT.SEL.CHANGED? 120611 . 122195)) (122245 133043 (TEDIT.GETPOINT 122255 . 122918) (TEDIT.GETSEL
122920 . 123138) (TEDIT.MAKESEL 123140 . 123940) (TEDIT.SCANSEL 123942 . 124699) (TEDIT.SET.SEL.LOOKS
124701 . 127580) (TEDIT.SETSEL 127582 . 132429) (TEDIT.SHOWSEL 132431 . 133041)))))
STOP